سليم حاصبيا قام بنشر سبتمبر 1, 2018 قام بنشر سبتمبر 1, 2018 فقط اكتب للاكسل ما تريد ان تبحث عنه واضغط الزر Run حرب هذا الملف Saerch_expressions.xlsm 6
عبدالرحمن حارثة قام بنشر سبتمبر 7, 2018 قام بنشر سبتمبر 7, 2018 جزيت خيرا وفي حالة يكون النص على شكل جدول يحتوي على اسماء أو ارقام
سليم حاصبيا قام بنشر سبتمبر 7, 2018 الكاتب قام بنشر سبتمبر 7, 2018 رداً على سؤال حارثة ابو زيد يلزم وقتها هذا الكود Option Explicit '============================== Sub colorize_ALL() Dim x%, k%, i%, m% Dim MY_St1$, MY_St2$, find_txt$ Dim My_Txt Dim Last_Row%: Last_Row = Cells(Rows.Count, 1).End(3).Row If Last_Row < 2 Then Last_Row = 2 MY_St2 = UCase(Range("c2")) Application.ScreenUpdating = False For i = 2 To Last_Row MY_St1$ = UCase(Range("a" & i).Value) With Range("a" & i).Font .ColorIndex = 0: .Underline = False: .Italic = False: .Bold = False End With '================================== For m = 1 To Len(MY_St1) - Len(MY_St2) + 1 find_txt$ = Mid(MY_St1, m, Len(MY_St2)) If find_txt$ = MY_St2 Then With Range("a" & i).Characters(m, Len(MY_St2)).Font .ColorIndex = 3: .Underline = True: .Italic = True: .Bold = True k = k + 1 End With End If Next m i = i + Range("a" & i).MergeArea.Rows.Count - 1 Next i Select Case k Case 0: Range("b2") = "Nothing similar" Case Else: Range("b2") = "There are: " & Chr(10) & k & " Expressions" End Select If k = 1 Then Range("b2") = Mid(Range("b2"), 1, Len(Range("b2")) - 1) Exite_Me: Application.ScreenUpdating = True End Sub الملف مرفق (مغ بعض الشرح في الورقة Sheet1) Full_Saerch_expressions.xlsm 3
سليم حاصبيا قام بنشر سبتمبر 7, 2018 الكاتب قام بنشر سبتمبر 7, 2018 4 ساعات مضت, حارثة ابو زيد said: جزيت خيرا وفي حالة يكون النص على شكل جدول يحتوي على اسماء أو ارقام يمكن ذلك (المشاركة بعد سؤالك مباشرة)
Mina AboElSaad قام بنشر أكتوبر 9, 2018 قام بنشر أكتوبر 9, 2018 (معدل) جميل جداااا سلمت يداك استاذى العزيز تم تعديل أكتوبر 9, 2018 بواسطه Mina AboElSaad
الردود الموصى بها
Join the conversation
You can post now and register later. If you have an account, sign in now to post with your account.