[حل شده] پیدا کردن کلمه مشابه که در یک لیست قرار دارد درون یک جمله

[aryan-ams]

سلام
دنبال کدی هستم که بتوان با توجه به لیستی از اسامی که مشخص است آنها را در متن پیدا و جدا کرد
مثلا در یک سلول نوشته شده "موسسه کمال دانش" و چون در لیست 1500 اسمی من کلمه "دانش" وجود دارد این کلمه از متن جدا شود
با تشکر

[Ali Parsaei]

سلام،
دقيقا" نفهميدم که منظورتان از اينکه: "از متن جدا شود" چيست!
شما با تابع find يا تابع serch و يا با کليک دگمه هاي ctrl+f مي توانيد عبارات را جستجود کنيد

به عنوان مثال:
مي توانيد ctrl+f را کليک کنيد، عبارت دانش را تايپ کنيد find all را بزنيد،سپس ctrl+a را کليک کنيد و تمام موارد يافت شده در صفحه در حالت انتخاب قرار مي گيرند، بعد داخل صفحه در همان حال که تمام موارد در حال انتخاب هستند، روي يکي از موارد يافت شده راست کليک کنيد و رنگ آنها را عوض کنيد تا مشخص تر شوند.
اگر در ستون يا محدوده اي خاص ميخواهيد جستجو انجام شود اول ستون يا محدوده را انتخاب کنيد و سپس ctrl+f را کليک کنيد و ...

[M_ExceL]

سلام
دنبال کدی هستم که بتوان با توجه به لیستی از اسامی که مشخص است آنها را در متن پیدا و جدا کرد
مثلا در یک سلول نوشته شده "موسسه کمال دانش" و چون در لیست 1500 اسمی من کلمه "دانش" وجود دارد این کلمه از متن جدا شود
با تشکر

سلام،
با این فرض که لیست شما داخل رنج a1:a1500 قرار دارد، از کد زیر استفاده کنید :

Sub test()

For i = 1 To 1500
newStr = Replace(Range("a" & i), "دانش", "")
Range("a" & i) = newStr

Next i
End Sub

کد فوق، کلمه دانش رو از داخل متون رنج a1:a1500 حذف میکنه.
در پناه حق.

[aryan-ams]

- - - Updated - - -

سلام،
با این فرض که لیست شما داخل رنج a1:a1500 قرار دارد، از کد زیر استفاده کنید :

Sub test()

For i = 1 To 1500
newStr = Replace(Range("a" & i), "دانش", "")
Range("a" & i) = newStr

Next i
End Sub

کد فوق، کلمه دانش رو از داخل متون رنج a1:a1500 حذف میکنه.
در پناه حق.

مرسی از پاسخ گویی شما من منظورم رو بد گفتم
یک لیست از کلمات دارم "دانش - مهارت - علم و ..." و یک لیست هم جمله
من می خوام در لیست جملات هر کدام از کلمات بود را جدا کنه و در سلول روبروش بنویسه
باز هم ممنون از وقتی که گذاشتید

[M_ExceL]

- - - Updated - - -

مرسی از پاسخ گویی شما من منظورم رو بد گفتم
یک لیست از کلمات دارم "دانش - مهارت - علم و ..." و یک لیست هم جمله
من می خوام در لیست جملات هر کدام از کلمات بود را جدا کنه و در سلول روبروش بنویسه
باز هم ممنون از وقتی که گذاشتید

سلام
خواهش میکنم
از کد زیر بروش های مختلف می تونید استفاده کنید :

Sub test()
For i = 1 To 1500
If Range("a" & i) Like "*دانش*" Then
Range("b" & i) = "دانش"
End If
Next i
End Sub

[aryan-ams]

سلام
خواهش میکنم
از کد زیر بروش های مختلف می تونید استفاده کنید :

Sub test()
For i = 1 To 1500
If Range("a" & i) Like "*دانش*" Then
Range("b" & i) = "دانش"
End If
Next i
End Sub

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

[aryan-ams]

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

- - - Updated - - -

Book1.xlsxBook1.xlsx

[M_ExceL]

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

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

Sub test()
Application.ScreenUpdating = False
lsn = Range("e" & Rows.Count).End(xlUp).Row
Range("e2" & ":e" & lsn).ClearContents
Range("d1") = "در اين ستون درصورت موجود بودن، جمله مربوطه اورده مي شود"
Range("e1") = "کلمات استخراج شده"
For Z = 2 To 67
For i = 2 To 1136
If Range("a" & Z) Like "*" & Range("b" & i) & "*" Then
Range("d" & i) = Range("a" & Z)
Range("e2000").End(xlUp).Offset(1, 0) = Range("b" & i)
End If
Next i
Next Z
Application.ScreenUpdating = True
End Sub

[aryan-ams]

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

Sub test()
Application.ScreenUpdating = False
lsn = Range("e" & Rows.Count).End(xlUp).Row
Range("e2" & ":e" & lsn).ClearContents
Range("d1") = "در اين ستون درصورت موجود بودن، جمله مربوطه اورده مي شود"
Range("e1") = "کلمات استخراج شده"
For Z = 2 To 67
For i = 2 To 1136
If Range("a" & Z) Like "*" & Range("b" & i) & "*" Then
Range("d" & i) = Range("a" & Z)
Range("e2000").End(xlUp).Offset(1, 0) = Range("b" & i)
End If
Next i
Next Z
Application.ScreenUpdating = True
End Sub

عالی بود مرسی که وقت گذاشتین

[M_ExceL]

عالی بود مرسی که وقت گذاشتین

سلام
خواهش میکنم
کد کاملتر گردید، (عدم نمایش کلمات تکراری استخراج شده)

Sub test()
Application.ScreenUpdating = False
lsn = Range("e" & Rows.Count).End(xlUp).Row
Range("e2" & ":e" & lsn).ClearContents
Range("d1") = "در اين ستون درصورت موجود بودن، جمله مربوطه اورده مي شود"
Range("e1") = "کلمات استخراج شده"
For Z = 2 To 67
For i = 2 To 1136
If Range("a" & Z) Like "*" & Range("b" & i) & "*" Then
Range("d" & i) = Range("a" & Z)
Range("e2000").End(xlUp).Offset(1, 0) = Range("b" & i)
End If
Next i
Next Z
lsnd = Range("e" & Rows.Count).End(xlUp).Row
Range("e2" & ":e" & lsnd).RemoveDuplicates Columns:=1, Header:=xlNo
Application.ScreenUpdating = True
End Sub

در پناه حق.