استفاده از Regular Expressions یا به اختصار RegEx برای جستجو و جایگذاری عبارت در متن

[mazoolagh]

2- حالا میریم سر وقت تکه دوم که قرار هست تکراری ها رو با back reference به تکه اول پیدا کنه:

test_it Join(Parts, " "), pattern

test_it Join(Parts, vbCrLf), pattern

pattern=(\b\w+\b)(?=.*\b\1\b)             count=7

This is the part and part now 

pattern=(\b\w+\b)(?=.*\b\1\b)             count=0

اینجا کاملا واضح هست که این پترن در حالت single line مشکل نداره (احتمالا و با توجه به شرایط)،
ولی وقتی در متن vbcrlf داریم کار نمیکنه!

[mazoolagh]

از اینجا به بعد برای تشخیص تکراری ها میتونیم 2 راه در پیش بگیریم:
- یکی این که وقت و انرژی بگذاریم و یک پترن دقیق و در برگیرنده همه حالت ها بسازیم (راه سخت و زمانبر)
- با یکی از پترن های پست 70 یا 80 (یا هر پترن دیگه که شرایط سناریو ما رو برآورده میکن)
یک لیست از همه کلمه ها بسازیم و از روی این لیست تکراری ها رو پیدا کنیم (راه ساده و سریع)

در کد نمونه زیر پس از درست کردن یک لیست از همه کلمه ها،
یک دیکشنری میسازیم و در یک لوپ روی لیست،
اگر یک کلمه در دیکشنری نبود اون رو اضافه میکنیم (بعنوان کلید) و تعداش رو 1 میگذاریم (بعنوان item)،
و اگر از قبل وجود داشت مقدار item رو یکی اضافه میکنیم.

    Dim Parts()

    Parts = Array( _

        "USE IRAN;", _

        "WITH ALLCITIES AS (", _

        "SELECT City , CityID, DistrictID FROM Cities WHERE CITY IS NOT NULL", _

        "UNION", _

        "SELECT RuralDistrict AS City, RuralDistrictID AS CityID, DistrictID FROM RuralDistricts WHERE RuralDistrict IS NOT NULL", _

        ")", _

        "SELECT", _

        "        states.State , states.StateID,", _

        "        Counties.County , Counties.CountyID,", _

        "        Districts.District , Districts.DistrictID,", _

        "        ALLCITIES.City , ALLCITIES.CityID", _

        "FROM states", _

        "    LEFT JOIN Counties ON states.StateID=Counties.StateID", _

        "    LEFT JOIN Districts ON Counties.CountyID=Districts.CountyID", _

        "    LEFT JOIN ALLCITIES ON Districts.DistrictID=ALLCITIES.DistrictID", _

        "ORDER BY states.State, Counties.County, Districts.District, ALLCITIES.City", _

        "COLLATE Persian_100_CI_AI", _

        "FOR JSON AUTO ,WITHOUT_ARRAY_WRAPPER;")

    

    Const pattern = "(\S+)"

    Dim mc As MatchCollection

    Dim m As match

    

    With New RegExp

        .Global = True

        .IgnoreCase = True

        .Multiline = True

        .pattern = pattern

        Set mc = .Execute(Join(Parts, vbCrLf))

    End With

    

    Dim d As New Dictionary

    For Each m In mc

        If d.Exists(m.Value) Then

            d(m.Value) = d(m.Value) + 1

        Else

            d.Add key:=m.Value, item:=1

        End If

    Next

    Dim item

    Dim i As Integer

    For i = 0 To d.Count - 1

        If d.Items(i) > 1 Then

            Debug.Print d.Keys(i), d.Items(i)

        End If

Next

Set d = Nothing

ALLCITIES      2 

AS             3 

SELECT         3 

,              5 

CityID,        2 

DistrictID     2 

FROM           3 

WHERE          2 

IS             2 

NOT            2 

NULL           2 

RuralDistrict  2 

ALLCITIES.City               2 

LEFT           3 

JOIN           3 

ON             3 

[mazoolagh]

لطفاً توابع پائین رو تست بفرمائین !

Public Function RemoveDupesInString(strText As String, Optional strDelim As String = " ") As String

Dim varArray As Variant

Dim intI As Integer

Dim strOut As String

strText = " " & strText & " "

varArray = Split(strText, strDelim)

For intI = 0 To UBound(varArray) - 1

    If InStr(strOut, varArray(intI)) = 0 Then

       strOut = strOut & varArray(intI) & " "

    End If

Next

RemoveDupesInString = Trim(strOut)

End Function









Public Function DupesRegexp(StrReg As String)

Dim regx

Dim Matches As Object

Dim Match As Object

Dim Str As String

Set regx = CreateObject("VBScript.RegExp")

regx.Global = True

regx.IgnoreCase = True

regx.Multiline = True

regx.Pattern = "(\b\w+\b)(?=.*\b\1\b)"

Set Matches = regx.Execute(StrReg)

For Each Match In Matches

    Str = Str & " " & Match.Value

Next

Str = Right(Str, Len(Str) - 1)

MsgBox RemoveDupesInString(Str)

End Function





Call DupesRegexp("Secure, smart, and easy to use email Get more done with Gmail. Now integrated with google Chat, Google Meet, and more, all in one place.")

سلام دوباره
گویا این کد برای پاک کردن موارد تکراری هست - که از پرسش اصلی پست 68 سختتره (فقط پیدا کردن تکراری ها)!
در نگاه اول کد زیر حالت خاص هست:

strText = " " & strText & " "

[eb_1345]

اگر بخواهیم ببینیم چه واژه هایی در یک عبارت تکرار شدن چه پترنی باید استفاده کنیم؟

من چند مورد رو امتحان کردم واژه های تکراری رو نمایش میده ولی بعضی از اونها سلکت نمیشن
البته فکر کنم بشه که با همین پترن اول موارد تکراری ( همون هائی که سلکت میشن) پشت سر هم بصورت یک رشته تبدیل کرد و بعد موارد تکراری این رشته رو حذف کرد . که در نهایت در رشته واژه هائی که تکرار شده اند بدست بیاد.

سلام دوباره
گویا این کد برای پاک کردن موارد تکراری هست - که از پرسش اصلی پست 68 سختتره (فقط پیدا کردن تکراری ها)!
در نگاه اول کد زیر حالت خاص هست:

strText = " " & strText & " "

با عرض سلام متقابل
تابع اول برای حذف موارد تکراری لیست واژ های که بوسیله پترن استخراج شده میباشه
فرض می کنیم در متن زیر میخواهیم لیست واژه ها یا کلماتی که تکرار شده اند بدست بیاریم:

Secure, smart, and easy to use email Get more done with Gmail. Now integrated Google with google Chat Google Meet and more all in one Google all and all all All meet all

با استفاده از پترن (\b\w+\b)(?=.*\b\1\b) لیست کلمات تکراری بصورت زیر استخراج میشه:

and more with Google google Google Meet and all all all all All

در لیست فوق می بینیم که مثلاً واژه all (با در نظر گرفتن حساسیت به بزرگی و کوچکی حروف) در متن 6 مرتبه تکرار شده ولی پترن تعداد 5 تای اون رو انتخاب میکنه و دلیلش فعلاً برای بنده معلوم نیست
ولی صرفنظر از اینکه از تعداد واژهای تکرار شده چه واژه هائی انتخاب میشن یا نمیشن پترن فوق در تشخیص واژه های تکراری درست عمل میکنه
حالا اگه ما فقط بخواهیم بدونیم که چه واژه هائی در متن بیشتر از یکبار تکرار شده اند بدون اینکه همه واژه های تکراری در لیست درج بشه با استفاده از تابعی که برای حذف موارد تکراری ایجاد کرده ام موارد تکراری لیست واژه های تکراری اسخراج شده بوسیله پترن رو حذف می کنیم .

که در نهایت با استفاده از تابع حذف واژه های تکراری خروجی لیست استخراج شده بوسیله پترن بصورت زیر نمایش داده میشه:

and more with Google Meet all

یعنی در متن 6 تا کلمه فوق (بیشتر از یکبار) تکرار شده اند.
لطفا فایل نمونه رو بررسی بفرمائین !

[mazoolagh]

سلام دوباره

...
در لیست فوق می بینیم که مثلاً واژه all (با در نظر گرفتن حساسیت به بزرگی و کوچکی حروف) در متن 6 مرتبه تکرار شده ولی پترن تعداد 5 تای اون رو انتخاب میکنه و دلیلش فعلاً برای بنده معلوم نیست
...

در استفاده از back-reference ، خود refrence هم در شمارش میاد.
اگر خاطرتون باشه در پست شماره 45 اشاره کرده بودم (ارقام تکراری در کد ملی).

لطفا فایل نمونه رو بررسی بفرمائین !

پس شما یک بار از روی match collection یک string میسازین،
بعد در اون استرینگ تکراری ها رو حذف میکنین. من اول فکر کردم تکراری ها رو از عبارت اصلی حذف میکنین.
اگر به هر دلیلی نمیخواین از دیکشنری استفاده کنین که خیلی ساده تر هست (پست شماره 82)،
باز هم تابع RemoveDupesInString بنظر اضافه میاد!
شما در همون لوپ For Each Match In Matches در تابع DupesRegexp هم میتونین این کار رو بکنین.

[eb_1345]

جستجو در سمت جلو و عقب با استفاده از عبارتهای (=?) و (=>?)
با استفاده از عبارت های فوق تطبیق وقتی صورت می گیره که یا در ادامه یا قبل از اون کاراکتر مورد نظر آمده باشه .
فرض می کنیم در یک متنی دنبال حرف انگلیسی g می گردیم که قبل از اون حرف e باشه
عبارت پترن رو باید بصورت زیر وارد کنیم که تطبیق صورت بگیره :

(?<=e)g

در متن زیر در کلمه integrated حرف g قرار داره که قبلش حرف e میباشه

Get more done with Gmail. Now integrated with Google Chat,

حالا اگه دنبال حرف d بگردیم که بعد از اون حرف o باشه عبارت پترن رو باید بصورت زیر وارد کنیم :

d(?=o)

با پترن فوق در متن بالا حرف d که بعد از اون حرف o باشه در کلمه done وجود داره
البته بجای یک حرف میشه دنبال چند حرف هم گشت . مثلا در متن بالا می خواهیم حروف tegrated جستجو بشه که قبل از این حروف حرف n درج شده باشه . که در این حالت عبارت پترن بصورت زیر وارد میشه :

(?<=n)tegrated

[eb_1345]

از مدیر محترم تالار جناب آقای جناب ميرزازاده عزيز بخاطر اصلاح عنوان تاپیک تشکر و سپاسگزاری می نمایم .