بسم الله الرحمن الرحيم
اهلا بحضراتكم متابعى موقع ومدونة عالم الاوفيس
اليوم لدينا درس مهم جدا من دروس اكسل vba ودرس حصرى على الانترنت وهو عن :كيفية البحث باى حرف من الكلمة مثل الهاتف الاندوريد excel vba
يعنى اية الكلام دة .
لو عندى بيانات مكونة من مجموعة من الاسماء ولكن هذة البيانات كثيرة جدا واريد ان ابحث عن بيان معين من خلال كتابة اول حرف او اى حرف فى الكلمة بحيث انة يلون لى نتيجة البحث حتى تظهر بسهولة مثل دليل الهاتف فى التليفون الاندرويد
مثل هذ الشكل واريد عندما اكتب اى حرف فى الخلية A1 يتم تلوين جميع الحروف المتطابقة بلون مخلتف وليكن احمر
كما بالشكل السابق
اذا السؤال الان كيف اقوم بعمل هذا الكود
فى البداية نذهب الى تبويب المطور Developer وندخل على نافذة محرر الاكواد ونكتب الكود التالى
Private Sub SelectAndChange(strValue As String)
Dim rngCell As Range
Dim rngRange As Range
Dim strLookFor As String
Dim lngCounter As Long
Dim lr As Long
lr = Cells(Rows.Count, 1).End(xlUp).Row
If strValue = vbNullString Then Range("a2:a" & lr).Font.Color = vbWhite: Exit Sub
Application.EnableEvents = False
Set rngRange = Range("a2:a" & lr)
rngRange.Font.Color = vbWhite
strLookFor = Range("A1").Value
For Each rngCell In rngRange
For lngCounter = 1 To Len(rngCell) - Len(strLookFor) + 1
If Mid(rngCell, lngCounter, Len(strLookFor)) = strLookFor Then
rngCell.Characters(lngCounter, Len(strLookFor)).Font.Color = vbRed
End If
Next lngCounter
Next rngCell
Application.EnableEvents = True
End Sub
ولمعرفة شرح الكود يرجى متابعة فيديو الشرح
ثم بعد ذلك ندخل الى حدث change فى worksheet ونكتب الكود التالى
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Count > 1 Then Exit Sub
SelectAndChange (Target)
End Sub
,وحتى يتم التسهيل على حضراتكم يمكنكم تحميل ملف العمل بالاكواد جاهز