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

برای اینکه متوجه بشیم مطالب آموزشی تا اینجا برای دوستان علاقمند مفید فایده بوده در این پست سوالی ساده طرح می کنیم

با توجه به توضیحات پست 49 میخواهیم یک پترن بنویسیم که در متن انگلیسی زیر کلماتی که حرف آخرشون e میباشه بجای حرف e آخر کلمه عدد 9 جایگزین بشه . مثل کلمه home به hom9 تبدیل بشه.
تاکید می کنم این جایگزینی فقط باید در کلماتی که حرف آخرشون e میباشه صورت بگیره نه کلماتی که حرف e در اول یا وسطشون می باشه
برای تست از کدهای پست 49 استفاده کنین!
Social media star Peanut the Squirrel has been euthanized after being seize from NY home

قطعاً جواب این سوال برای دوستانی که مطالب ارائه شده رو با دقت مرور کرده ان بسیار ساده خواهد بود .
متن خروجی باید بصورت زیر باشه :
Social media star Peanut th9 Squirrel has been euthanized after being seiz9 from NY hom9

نسخه آپدیت شده برنامه نمونه

نقل قول:

---

نوشته شده توسط mazoolagh

3- موضوع کاربردی اینجاست:

        .Pattern = "(.)\1{9}"

در واقع الگوریتم انتخاب شده برای کد ملی یک اشکال داره و اونهم این هست که
اگر همه ارقام یکی باشن معتبر نشون میده (البته در واقعیت ما باید از یک api استفاده کنیم و کد ملی رو با سایر مشخصات تطبیق بدیم).
در این پترن از چیزی استفاده کردیم که بهش back-reference میگن و برای capture group شماره 1 - 9 بار تکرار میشه (جمعا 10 بار).
وگرنه میبایست همه این 10 حالت رو چک میکردیم - حالا یا یکی یکی یا در یک حلقه.
.

---

با سلام و وقت بخیر
در تابع فوق نمیشه از طریق کد زیر تکراری بودن 10 رقم کد ملی رو چک کرد؟

If Len(SSID) - Len(Replace(SSID, Left(SSID, 1), "")) = 10 Then

   IsValidSSID = False

   Exit Function

End If

نقل قول:

---

نوشته شده توسط eb_1345

با سلام و وقت بخیر
در تابع فوق نمیشه از طریق کد زیر تکراری بودن 10 رقم کد ملی رو چک کرد؟

If Len(SSID) - Len(Replace(SSID, Left(SSID, 1), "")) = 10 Then

   IsValidSSID = False

   Exit Function

End If

---

سلام دوباره
قطعا میشه،
این دست شماست که چه روشی پیاده کنین.
گاهی در حالتهایی خاص (مثل اینجا که تکراری بودن شامل همه استرینگ هست) میشه کدهایی شبیه این نوشت،
یا حتی کوتاهترش کرد:

If Replace(SSID, Left(SSID, 1), "")="" Then

   IsValidSSID = False

   Exit Function

End If

شما هر کاری رو که با regex انجام میدین،
با همین توابع string و split و ... هم میشه.
گاهی حتی ساده تر هم هست (پست 44)، و خب گاهی ممکنه خیلی سخت تر باشه - ولی میشه.

به طور مطلق نمبتونین بگین کدوم برتری داره: در سناریو هست که با توجه به شرایط مشخص میشه.

در همین مثال اگر مسئله به این صورت تغییر کنه:
آیا یک استرینگ شامل حروف تکراری (2 یا بیشتر) پشت سر هم هست؟
مثل abcdddefgghhhhxyyyxx که باید اینها رو پیدا کنه: abcdddefgghhhhxyyyxx
دیگه کدی که فقط با توابع استرینگ پیاده شده باشه، شاید نوشتنش به سادگی این مثال نباشه (همیشه شدنی هست)
ولی همین روش back-refrence با یک پترن ساده پاسخگو هست:

 (.)\1+

دیگه انتخابش با شماست که یک Trade-off بین زمان رسیدن به پاسخ، سادگی نگهداری و دیباگ، خوانایی، پرفورمنس و ... انجام بدین.

در پست شماره 34 یک بخش هست که چند بار میخواستم بپرسم و فراموش کردم:

نقل قول:

---

البته در متن انگلیسی برای بدست آوردن تعداد یک کاراکتر یا کلمه خاص در یک متن میتونیم با ترکیب تابع Len و Replace اینکار رو انجام بدهیم
مثلاً در همون مثال اولی میخواهم تعداد حرف o رو در متن www.bahrami125@yahoo.com ورودی بدست بیاریم.
برای اینکار تابع رو بصورت زیر مینویسیم :

CountWords = Len("www.bahrami125@yahoo.com") - Len(Replace("www.bahrami125@yahoo.com", "o", ""))

ولی با این کد تعداد در متون فارسی درست بدست نمیاد ولی تابعی که در اون از پترن استفاده شده برای بدست آوردن تعداد در هر دو حالت فارسی و انگلیسی مناسبتره

---

این بخش رو میشه بیشتر توضیح بدین که روی چه استرینگ هایی تست کردین که جواب نداده؟

نقل قول:

---

نوشته شده توسط mazoolagh

در پست شماره 34 یک بخش هست که چند بار میخواستم بپرسم و فراموش کردم:


این بخش رو میشه بیشتر توضیح بدین که روی چه استرینگ هایی تست کردین که جواب نداده؟

---

با عرض سلام
لطفاً مورد زیر رو امتحان بفرمائید!

MsgBox Len("در حالي که من با چشم هاي خودم  ديدم و اين در حالي بود که ....") - Len(Replace("در حالي که من با چشم هاي خودم  ديدم و اين در حالي بود که ....", "حالي", ""))

البته ناگفته نمونه که تعداد خروجی همیشه هم اشتباه نیست . شاید استفاده از تابع Trim برای آرگومان مقدار مورد جستجو مشکل رو برطرف کنه

نقل قول:

---

نوشته شده توسط eb_1345

برای اینکه متوجه بشیم مطالب آموزشی تا اینجا برای دوستان علاقمند مفید فایده بوده در این پست سوالی ساده طرح می کنیم

با توجه به توضیحات پست 49 میخواهیم یک پترن بنویسیم که در متن انگلیسی زیر کلماتی که حرف آخرشون e میباشه بجای حرف e آخر کلمه عدد 9 جایگزین بشه . مثل کلمه home به hom9 تبدیل بشه.
تاکید می کنم این جایگزینی فقط باید در کلماتی که حرف آخرشون e میباشه صورت بگیره نه کلماتی که حرف e در اول یا وسطشون می باشه
برای تست از کدهای پست 49 استفاده کنین!
Social media star Peanut the Squirrel has been euthanized after being seize from NY home

قطعاً جواب این سوال برای دوستانی که مطالب ارائه شده رو با دقت مرور کرده ان بسیار ساده خواهد بود .
متن خروجی باید بصورت زیر باشه :
Social media star Peanut th9 Squirrel has been euthanized after being seiz9 from NY hom9

---

باسلام
فکر کنم باید از پترن زیر استفاده کنیم

[e]\b

برای حل این مسئله از مثال مربوط به علامت \b در فایل نمونه اسفاده کردم.

نقل قول:

---

نوشته شده توسط mazoolagh

شما هر کاری رو که با regex انجام میدین،
با همین توابع string و split و ... هم میشه.
گاهی حتی ساده تر هم هست (پست 44)، و خب گاهی ممکنه خیلی سخت تر باشه - ولی میشه.

به طور مطلق نمبتونین بگین کدوم برتری داره: در سناریو هست که با توجه به شرایط مشخص میشه.

---

بنده هر کاری کردم نتوانستم مسئله بالا رو از طریق توابع string و split حل کنم . اگر استاد راهنمائی کنن که از طریق توابع فوق به چه صورتی باید برای حل مسئله فوق استفاده کنیم ممنون میشوم

نقل قول:

---

نوشته شده توسط eb_1345

با عرض سلام
لطفاً مورد زیر رو امتحان بفرمائید!

MsgBox Len("در حالي که من با چشم هاي خودم  ديدم و اين در حالي بود که ....") - Len(Replace("در حالي که من با چشم هاي خودم  ديدم و اين در حالي بود که ....", "حالي", ""))

البته ناگفته نمونه که تعداد خروجی همیشه هم اشتباه نیست . شاید استفاده از تابع Trim برای آرگومان مقدار مورد جستجو مشکل رو برطرف کنه

---

سلام دوباره
استرینگ ها در اکسس یونیکد نگهداری میشن و توابع استرینگ و regex به زبان حساس نیست.

اونچه برداشت میکنم این هست که شما دنبال تعداد "حالی" هستین، که 4 حرفی هست،
ولی کد پست 34 برای یک استرینگ یک کارآکتری درست کار میکنه - در واقع یک حالت خاص هست.
شما باید اندازه استرینگی رو که دنبالش هستین در محاسبات بیارین:

PUBLIC FUNCTION CountOf( _

                        Expression AS STRING, _

                        Find AS STRING _

                        ) AS INTEGER

    DIM LenE AS INTEGER, LenF AS INTEGER

    LenE=LEN(Expression)

    LenF=LEN(Find)

    IF LenF=0 OR LenE=0 THEN

        CountOf=0

    ELSE

        CountOf=(LenE - LEN(REPLACE(Expression , Find , "")))/LenF

    ENDIF

END FUNCTION

نقل قول:

---

نوشته شده توسط eb_1345

با عرض سلام
لطفاً مورد زیر رو امتحان بفرمائید!

MsgBox Len("در حالي که من با چشم هاي خودم  ديدم و اين در حالي بود که ....") - Len(Replace("در حالي که من با چشم هاي خودم  ديدم و اين در حالي بود که ....", "حالي", ""))

البته ناگفته نمونه که تعداد خروجی همیشه هم اشتباه نیست . شاید استفاده از تابع Trim برای آرگومان مقدار مورد جستجو مشکل رو برطرف کنه

---

روش های دیگه هم میشه به کار برد:

PUBLIC FUNCTION CountOf( _

                        Expression AS STRING, _

                        Find AS STRING _

                        ) AS INTEGER

    IF LEN(Find)=0 OR LEN(Expression)=0 THEN

        CountOf=0

    ELSE

        DIM X AS VARIANT

        X=SPLIT(Expression , Find)

        CountOf=UBOUND(X)

    ENDIF

END FUNCTION

PUBLIC FUNCTION CountOf( _

                        Expression AS STRING, _

                        Find AS STRING _

                        ) AS INTEGER

                        

    IF LEN(Find)=0 OR LEN(Expression)=0 THEN

        CountOf=0

        EXIT FUNCTION

    ENDIF

    

    DIM Start AS INTEGER

    Start=1

    DO WHILE INSTR(Start , Expression , Find) > 0

        CountOf=CountOf + 1

        Start=1 + INSTR(Start , Expression , Find)

    LOOP

END FUNCTION

نقل قول:

---

نوشته شده توسط atf1379

نوشته شده توسط mazoolagh https://barnamenevis.org/images/butt...wpost-left.png
شما هر کاری رو که با regex انجام میدین،
با همین توابع string و split و ... هم میشه.
گاهی حتی ساده تر هم هست (پست 44)، و خب گاهی ممکنه خیلی سخت تر باشه - ولی میشه.

به طور مطلق نمبتونین بگین کدوم برتری داره: در سناریو هست که با توجه به شرایط مشخص میشه.
بنده هر کاری کردم نتوانستم مسئله بالا رو از طریق توابع string و split حل کنم . اگر راهنمائی کنن که از طریق توابع فوق به چه صورتی باید برای حل مسئله فوق استفاده کنیم ممنون میشوم

---

منظورتون مسئله پست 51 هست؟
ساده است که!

تا کجا پیش رفتین؟

نقل قول:

---

نوشته شده توسط mazoolagh

سلام دوباره
استرینگ ها در اکسس یونیکد نگهداری میشن و توابع استرینگ و regex به زبان حساس نیست.

اونچه برداشت میکنم این هست که شما دنبال تعداد "حالی" هستین، که 4 حرفی هست،
ولی کد پست 34 برای یک استرینگ یک کارآکتری درست کار میکنه - در واقع یک حالت خاص هست.
شما باید اندازه استرینگی رو که دنبالش هستین در محاسبات بیارین:

PUBLIC FUNCTION CountOf( _

                        Expression AS STRING, _

                        Find AS STRING _

                        ) AS INTEGER

    DIM LenE AS INTEGER, LenF AS INTEGER

    LenE=LEN(Expression)

    LenF=LEN(Find)

    IF LenF=0 OR LenE=0 THEN

        CountOf=0

    ELSE

        CountOf=(LenE - LEN(REPLACE(Expression , Find , "")))/LenF

    ENDIF

END FUNCTION

---

احسنت !:تشویق::تشویق::تشویق:

همونطور که در پست 34 اشاره شد از تابع زیر هم برای بدست اوردن تعداد مقدار مورد جستجو میشه استفاده کرد :

Public Function RegExCountWords(ByVal Text As String, PatternText As String) As Long

Dim regx

Set regx = CreateObject("VBScript.RegExp")

regx.Pattern = PatternText

regx.Global = True

RegExCountWords = regx.Execute(Text).Count

End Function

نقل قول:

---

نوشته شده توسط eb_1345

برای اینکه متوجه بشیم مطالب آموزشی تا اینجا برای دوستان علاقمند مفید فایده بوده در این پست سوالی ساده طرح می کنیم

با توجه به توضیحات پست 49 میخواهیم یک پترن بنویسیم که در متن انگلیسی زیر کلماتی که حرف آخرشون e میباشه بجای حرف e آخر کلمه عدد 9 جایگزین بشه . مثل کلمه home به hom9 تبدیل بشه.
تاکید می کنم این جایگزینی فقط باید در کلماتی که حرف آخرشون e میباشه صورت بگیره نه کلماتی که حرف e در اول یا وسطشون می باشه
برای تست از کدهای پست 49 استفاده کنین!
Social media star Peanut the Squirrel has been euthanized after being seize from NY home

قطعاً جواب این سوال برای دوستانی که مطالب ارائه شده رو با دقت مرور کرده ان بسیار ساده خواهد بود .
متن خروجی باید بصورت زیر باشه :
Social media star Peanut th9 Squirrel has been euthanized after being seiz9 from NY hom9

---

Option Compare Database

Option Explicit



Const Expression = "Eager elephants delighted in the serene evening, " + vbCrLf + _

            "feeling the gentle breeze under the green trees where they could see the sea." + vbCrLf + _

            "e E e se(25) agree- free8 THE e 87e e see. glee_ drive."



Function Replace_RegEx() As String

    With New RegExp

        .pattern = "e\b"

        .Global = True

        .IgnoreCase = False

        .Multiline = True

        Replace_RegEx = .Replace(Expression, "9")

    End With

End Function

تست:

? replace_regex

Eager elephants delighted in th9 seren9 evening, 

feeling th9 gentl9 breez9 under th9 green trees wher9 they could se9 th9 sea.

9 E 9 s9(25) agre9- free8 THE 9 879 9 se9. glee_ driv9.

نقل قول:

---

نوشته شده توسط eb_1345

برای اینکه متوجه بشیم مطالب آموزشی تا اینجا برای دوستان علاقمند مفید فایده بوده در این پست سوالی ساده طرح می کنیم

با توجه به توضیحات پست 49 میخواهیم یک پترن بنویسیم که در متن انگلیسی زیر کلماتی که حرف آخرشون e میباشه بجای حرف e آخر کلمه عدد 9 جایگزین بشه . مثل کلمه home به hom9 تبدیل بشه.
تاکید می کنم این جایگزینی فقط باید در کلماتی که حرف آخرشون e میباشه صورت بگیره نه کلماتی که حرف e در اول یا وسطشون می باشه
برای تست از کدهای پست 49 استفاده کنین!
Social media star Peanut the Squirrel has been euthanized after being seize from NY home

قطعاً جواب این سوال برای دوستانی که مطالب ارائه شده رو با دقت مرور کرده ان بسیار ساده خواهد بود .
متن خروجی باید بصورت زیر باشه :
Social media star Peanut th9 Squirrel has been euthanized after being seiz9 from NY hom9

---

بدون استفاده از regex

Function Replace_Simple() As String

    Dim x As String

    x = Expression

    Dim start As Integer

    start = InStr(1, x, "e", vbBinaryCompare)

    Do While start > 0

        If Not Mid(x, start + 1, 1) Like "[A-Za-z0-9_]" Then

            Mid(x, start, 1) = "9"

        End If

        start = InStr(1 + start, x, "e", vbBinaryCompare)

    Loop

    Replace_Simple = x

End Function

تست:

? replace_simple

Eager elephants delighted in th9 seren9 evening, 

feeling th9 gentl9 breez9 under th9 green trees wher9 they could se9 th9 sea.

9 E 9 s9(25) agre9- free8 THE 9 879 9 se9. glee_ driv9.

اطمینان از این که هر دو روش پاسخ یکسان دارن:

Debug.Print StrComp(Replace_RegEx, Replace_Simple, vbBinaryCompare) = 0

که true هست.

نقل قول:

---

نوشته شده توسط mazoolagh

بدون استفاده از regex

Function Replace_Simple() As String

    Dim x As String

    x = Expression

    Dim start As Integer

    start = InStr(1, x, "e", vbBinaryCompare)

    Do While start > 0

        If Not Mid(x, start + 1, 1) Like "[A-Za-z0-9_]" Then

            Mid(x, start, 1) = "9"

        End If

        start = InStr(1 + start, x, "e", vbBinaryCompare)

    Loop

    Replace_Simple = x

End Function

تست:

? replace_simple

Eager elephants delighted in th9 seren9 evening, 

feeling th9 gentl9 breez9 under th9 green trees wher9 they could se9 th9 sea.

9 E 9 s9(25) agre9- free8 THE 9 879 9 se9. glee_ driv9.

اطمینان از این که هر دو روش پاسخ یکسان دارن:

Debug.Print StrComp(Replace_RegEx, Replace_Simple, vbBinaryCompare) = 0

که true هست.

---

عالی مثل همیشه!:تشویق::تشویق::تشویق:

نقل قول:

---

نوشته شده توسط atf1379

بنده هر کاری کردم نتوانستم مسئله بالا رو از طریق توابع string و split حل کنم . اگر استاد راهنمائی کنن که از طریق توابع فوق به چه صورتی باید برای حل مسئله فوق استفاده کنیم ممنون میشوم

---

نقل قول:

---

نوشته شده توسط mazoolagh

بدون استفاده از regex

Function Replace_Simple() As String

    Dim x As String

    x = Expression

    Dim start As Integer

    start = InStr(1, x, "e", vbBinaryCompare)

    Do While start > 0

        If Not Mid(x, start + 1, 1) Like "[A-Za-z0-9_]" Then

            Mid(x, start, 1) = "9"

        End If

        start = InStr(1 + start, x, "e", vbBinaryCompare)

    Loop

    Replace_Simple = x

End Function

تست:

? replace_simple

Eager elephants delighted in th9 seren9 evening, 

feeling th9 gentl9 breez9 under th9 green trees wher9 they could se9 th9 sea.

9 E 9 s9(25) agre9- free8 THE 9 879 9 se9. glee_ driv9.

اطمینان از این که هر دو روش پاسخ یکسان دارن:

Debug.Print StrComp(Replace_RegEx, Replace_Simple, vbBinaryCompare) = 0

که true هست.

---

ممنون استاد
لطف کردین

نقل قول:

---

نوشته شده توسط atf1379

ممنون
لطف کردین

---

پترن پست شماره 63 در واقع همون پترن پیشنهادی شما در پست شماره 57 هست
که [] حذف شده - چون فقط یک کارآکتر بررسی میشه بهش نیازی نیست.

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

نقل قول:

---

نوشته شده توسط mazoolagh

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

---

عرض سلام و ارادت خدمت استاد مازولاق عزیز !
اختیار دارین بزرگوار !
قطعا حضور جنابعالی همراه با طرح سوالات و ارائه نکات فنی و تخصص هم باعث پربار شدن این تاپیک آموزشی میشه وهم دلگرمی بنده برای ادامه فعالیت

در فرم تشریح و تفسیر عبارات با قاعده فایل آپدیت شده ضمیمه رکوردی با عنوان انواع پترن های کاربردی ایجاد کرده ام که در قسمت سابفرم این رکورد تعداد 112 عبارات Regex که ممکنه در شرایط مختلف به اونها نیاز داشته باشیم اضافه نموده ام . برای دسترسی به پترن های فوق کلمه All رو از کمبوباکس جستجو انتخاب نمائین!

نقل قول:

---

نوشته شده توسط eb_1345

در فرم تشریح و تفسیر عبارات با قاعده فایل آپدیت شده ضمیمه رکوردی با عنوان انواع پترن های کاربردی ایجاد کرده ام که در قسمت سابفرم این رکورد تعداد 112 عبارات Regex که ممکنه در شرایط مختلف به اونها نیاز داشته باشیم اضافه نموده ام . برای دسترسی به پترن های فوق کلمه All رو از کمبوباکس جستجو انتخاب نمائین!

---

بسیار هم عالی!
شایسته است که این تاپیک sticky بشه!

===========

در تصویر اینجور بنظر میاد که رکورد تکراری هم هست، شایدم اشتباه میکنم.

نقل قول:

---

نوشته شده توسط eb_1345

در فرم تشریح و تفسیر عبارات با قاعده فایل آپدیت شده ضمیمه رکوردی با عنوان انواع پترن های کاربردی ایجاد کرده ام که در قسمت سابفرم این رکورد تعداد 112 عبارات Regex که ممکنه در شرایط مختلف به اونها نیاز داشته باشیم اضافه نموده ام . برای دسترسی به پترن های فوق کلمه All رو از کمبوباکس جستجو انتخاب نمائین!

---

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

نقل قول:

---

نوشته شده توسط mazoolagh

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

---

ظاهراً دوستان علاقه چندانی به موضوع این تاپیک ندارند .
با توجه به اینکه یجورائی پترن مورد نظر جنابعالی رو به فایل آپدیت شده در پست 70 اضافه نموده ام ولی ...
بعد از این همه مدت که از زمان ایجاد این تاپیک میگذره از دوستان انتظار میرفت که در خصوص مطالب آموزشی اظهار نظری هرچند مختصر ارائه نماین ولی متاسفانه به استثناء یک نفر بقیه دوستان صرفاً نظاره گر مطالب هستن

نقل قول:

---

نوشته شده توسط eb_1345

ظاهراً دوستان علاقه چندانی به موضوع این تاپیک ندارند ... صرفاً نظاره گر مطالب هستن

---

این regex بسیار بدقلق هست و شیب منحنی یادگیری اش هم کمه!
گذشته از این: بیشتر و نزدیک به همه، فقط برای رفع مشکلی که همون لحظه دچارش هستن اینجا میان و نه برای یاد گرفتن.
ولی در طی زمان بازدیدکننده ها با جستجو اینجا رو پیدا و ازش استفاده میکنن، پس دلسرد نباشین و ادامه بدین - تو نیکی میکن و در دجله انداز!

نقل قول:

---

نوشته شده توسط eb_1345

... پترن مورد نظر (پست شماره 68) رو به فایل آپدیت شده در پست 70 اضافه نموده ام ...

---

آره، در تصویر هم دیده میشه - ولی اون پترن (در همه حالتها) درست نیست !
باید سر فرصت با مثال نشون بدم.

نقل قول:

---

نوشته شده توسط mazoolagh

آره، در تصویر هم دیده میشه - ولی اون پترن (در همه حالتها) درست نیست !

---

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

نقل قول:

---

نوشته شده توسط eb_1345

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

---

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

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.")

ایراداتی در کد های فوق وجود داره که نیاز به چکش کاری استاد داره

سلام دوباره
الان یه کمی مطلب پیچیده شد - بذارین یکی یکی بریم جلو.

1- این پترن

(\b\w+\b)(?=.*\b\1\b)

دو تکه اس،
بهتره پیش از هر کاری عملکرد تکه اول رو که قراره کلمه ها رو پیدا کنه بررسی کنیم:

Sub duplicate_words()

    Const pattern = "(\b\w+\b)"

    Dim Parts()

    Parts = Array( _

        "This is the first part,", _

        "and this is the second part,", _

        "now and then", _

        "now another part added.")

        

    test_it Join(Parts, " "), pattern

    test_it Join(Parts, vbCrLf), pattern

End Sub



Sub test_it(Expression As String, pattern As String)

    Dim mc As MatchCollection

    Dim m As match

    

    With New RegExp

        .Global = True

        .IgnoreCase = True

        .Multiline = True

        .pattern = pattern

        Set mc = .Execute(Expression)

    End With

    Debug.Print "pattern=" & pattern, "count=" & mc.Count

    For Each m In mc

        Debug.Print m & " ";

    Next

    Debug.Print

End Sub

خروجی:

pattern=(\b\w+\b)           count=18

This is the first part and this is the second part now and then now another part added 

pattern=(\b\w+\b)           count=18

This is the first part and this is the second part now and then now another part added 

همینجور که دیده میشه این پترن با نقطه و ویرگول (چیزهای دیگه هست که میتونین خودتون تست کنین)
رفتار مشخصی داره و اون ها رو کنار میذاره -
که اگر در سناریو کاری ما مشکلی نداشته باشه خب همین خوبه و تا اینجا کلمه ها رو درست تشخیص میده (بخش پیدا کردن تکراری رو جدا بررسی میکنیم)،
وگرنه باید یک فکر دیگه برداریم.

حالا وضعیت زیر رو بببینیم:

test_it "sin(5x) a+b=c 192.168.1.1 first-name last_name [date] (\b\w+\b) end. ", pattern

نتیجه:

pattern=(\b\w+\b)           count=17

sin 5x a b c 192 168 1 1 first name last_name date b w b end 

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

در یک سناریوی دقیقتر، کلمه اینجوری تعریف میشه که هر رشته ای از کارآکترها که white space نداشته باشه:

test_it "sin(5x) a+b=c 192.168.1.1 first-name last_name [date] (\b\w+\b) end. ", "(\S+)"

pattern=(\S+) count=8

sin(5x) a+b=c 192.168.1.1 first-name last_name [date] (\b\w+\b) end.

انتخاب پترن به سناریوی ما برمیگرده - اینجور نیست که بگیم یکی بهتر هست،
شاید هیچکدام اینها پاسخگوی نیاز ما نباشه و لازم باشه یک پترن مناسب طراحی کنیم.

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 داریم کار نمیکنه!

از اینجا به بعد برای تشخیص تکراری ها میتونیم 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 

نقل قول:

---

نوشته شده توسط eb_1345

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

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 & " "

نقل قول:

---

نوشته شده توسط mazoolagh

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

---

نقل قول:

---

نوشته شده توسط eb_1345

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

---

نقل قول:

---

نوشته شده توسط mazoolagh

سلام دوباره
گویا این کد برای پاک کردن موارد تکراری هست - که از پرسش اصلی پست 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 تا کلمه فوق (بیشتر از یکبار) تکرار شده اند.
لطفا فایل نمونه رو بررسی بفرمائین !

سلام دوباره

نقل قول:

---

نوشته شده توسط eb_1345

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

---

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

نقل قول:

---

نوشته شده توسط eb_1345

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

---

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

جستجو در سمت جلو و عقب با استفاده از عبارتهای (=?) و (=>?)
با استفاده از عبارت های فوق تطبیق وقتی صورت می گیره که یا در ادامه یا قبل از اون کاراکتر مورد نظر آمده باشه .
فرض می کنیم در یک متنی دنبال حرف انگلیسی 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

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