كود vba او معادلة للبحث

[hicham2610]

السلام عليكم

من فضلكم أبحث عن كود vba 

يمكن من البحث عن الاسم  في السطر:2   الموافق للقيمة الموجودة في MIn العمود:AF ويضعها في العمود AG لغاية آخر سطر فيه بيانات وإن كان هناك أكثر من اسم يفصل بينهما ب ";"

إن لم يكن هناك كودvba فمعادلة بحث تمكن من ذلك

وجزاكم الله خيرا

1.xlsx

[سليم حاصبيا]

جرب هذا الكود

Option Explicit
Sub find_min()
Dim F As Worksheet, i%, k%
Dim lr, arr(1 To 8)
Dim m%: m = 1
Dim st$
Set F = Sheets("Feuil2")

lr = F.Cells(Rows.Count, "i").End(3).Row
If lr < 9 Then Exit Sub
F.Cells(9, "AG").Resize(lr).ClearContents
    For i = 9 To 30 Step 3
      arr(m) = i
      m = m + 1
    Next
 For k = 9 To lr
   For i = 1 To UBound(arr)
      If F.Cells(k, arr(i)) = F.Cells(k, "AF") Then
       st = st & F.Cells(2, arr(i) - 1) & ";"
      End If
   Next
   F.Cells(k, "AG") = Mid(st, 1, Len(st) - 1)
   st = vbNullString
Next
 Erase arr: Set F = Nothing
   End Sub

الملف مرفق مع زر لنتفذ الكود

 

 

find_min.xlsm

[ابو طيبه]

عاشت ايدك استاذ سليم  على هذا العطاء

الله يبارك بيك وبجهودك 

[hicham2610]

جزاك الله خيرا أخي الكريم

فقط تخرج نافذة الخطأ بعد التنفيد 

واسطر الملون بالأصفر في الكود هو:

F.Cells(k, "AG") = Mid(st, 1, Len(st) - 1)

 

[سليم حاصبيا]

استبدل  السطر حيث يوجد خطأ  في الكود بهذه الــ 3 سطور

If st <> vbNullString Then
     F.Cells(k, "AG") = Mid(st, 1, Len(st) - 1)
 End If

 

[hicham2610]

جزاك الله خيرا وأحسن إليك