قائمة منسدلة مطاطية تتجاهل القيم المخفية ( بالتصفية)

[bachiri401]

السلامن عليكم ورحمة الله وبركاته اخواني بالمنتدى بارك الله فيكم وجعل عملكم في ميزان حسناتكم

اريد منكم كيفية عمل قائمة منسدلة تاخذ في الحسبان فقط القيم الظاهرة بعد التصفية وتتجاهل القيم المخفية.

قائمة منسدلة مطاطية.xlsx

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

 بعد عماية الفلترة اضغط الزر Run

Option Explicit
Sub DATA_VAL()
Dim MY_RG As Range
Dim ro%, cel As Range
Dim dic As Object
Set dic = CreateObject("Scripting.Dictionary")
Set MY_RG = Range("E4").CurrentRegion.Columns(1)
If MY_RG.Rows.Count = 1 Then Exit Sub
Set MY_RG = MY_RG.Offset(1).Resize(MY_RG.Rows.Count - 1)
 For Each cel In MY_RG.Cells
   If cel.EntireRow.Hidden = False Then
    dic(cel.Value) = ""
   End If
 Next
 
 With Range("I3").Validation
 .Delete
 .Add 3, Formula1:=Join(dic.keys, ",")
 End With
 
 Set MY_RG = Nothing: Set dic = Nothing
End Sub

الملف مرفق

bashiri.xlsm

[bachiri401]

بارك الله فيك أخي على هذا العمل الرائع

فقط الا يمكن عمل مثل ذلك بالدوال فقط