اختيار اسم المقاطعة في حالة تكرار الرقم

[tahar]

عندي ارقام واسماء مقاطعات وجهة مقاطهة  اريد عند اختيار رقم مقاطعة وعند تكرار رقم يقوم باخراج قائمة منسدلة لاختيار اسم المقاطعة ومن ثم ياتي بالنتائج  وفي حالة رقم غير مكرر ياتي بالنتائج عادي

لا داعى اضغط الملف طالما مساحته صغيره

 

ray.xlsx

[عبدالله بشير عبدالله]

السلام عليكم 

اكتب الرقم في العمود F

الكود

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim ws As Worksheet
    Dim districtNumber As String
    Dim count As Integer
    Dim districtList As String
    Dim cell As Range
    Dim districtArray() As String
    Dim i As Integer
    Dim selectedDistrict As String
    
    Set ws = ThisWorkbook.Sheets("Feuil2")
    
    If Not Intersect(Target, ws.Range("F5:F" & ws.Cells(ws.Rows.count, "F").End(xlUp).Row)) Is Nothing Then
        districtNumber = CStr(Target.Value)
        
        If districtNumber <> "" Then
            count = Application.WorksheetFunction.CountIf(ws.Range("A2:A500"), districtNumber)
            
            If count > 1 Then
                districtList = ""
                For Each cell In ws.Range("A2:A" & ws.Cells(ws.Rows.count, "A").End(xlUp).Row)
                    If cell.Value = districtNumber Then
                        If districtList = "" Then
                            districtList = ws.Cells(cell.Row, "B").Value
                        Else
                            districtList = districtList & "," & ws.Cells(cell.Row, "B").Value
                        End If
                    End If
                Next cell
                
                districtArray = Split(districtList, ",")
                
                With UserForm1.ListBox1
                    .Clear
                    For i = LBound(districtArray) To UBound(districtArray)
                        .AddItem districtArray(i)
                    Next i
                End With
                
                UserForm1.Show
                
                If UserForm1.ListBox1.ListIndex <> -1 Then
                    selectedDistrict = UserForm1.ListBox1.Value
                Else
                    selectedDistrict = ""
                End If
                
                Target.Offset(0, 1).Value = selectedDistrict
            Else
                For Each cell In ws.Range("A2:A" & ws.Cells(ws.Rows.count, "A").End(xlUp).Row)
                    If cell.Value = districtNumber Then
                        Target.Offset(0, 1).Value = ws.Cells(cell.Row, "B").Value
                        Exit For
                    End If
                Next cell
            End If
        End If
    End If
End Sub

 

الملف

اسم المقاطعة.xlsb

تم تعديل الأربعاء at 11:53 بواسطه عبدالله بشير عبدالله

[tahar]

سلام عليكم

شكرا ساقوم بتجربتها 

هل يمكن استبدال الدالة =INDEX($C$2:$C$100; EQUIV(1; ($A$2:$A$100=F5)*($B$2:$B$100=G5); 0))

ب recherchv 

[عبدالله بشير عبدالله]

وعليكم السلام 

دالة recherchv  لا اجيدها  واعتقد انها فرنسية ولكن قمت بحل اخر  وان لم  يكن مناسبا لك قم بفتح موضوع جديد واطلب فيه دالة recherchv  وستجد من الخبراء من يقوم بذلك

تحياتي

اسم المقاطعة.xlsb

[tahar]

سلام  ممكن تعديل الكود

وضعت الجدول في ورقة أخرى  ,واين اضيف متغير للبحث

اسم المقاطعة تعديل.rar

تم تعديل الخميس at 19:06 بواسطه tahar

[عبدالله بشير عبدالله]

اين تريد النتائج في اي صفحة  واي مدى

[tahar]

سلام عليكم وشكر لك مسبقا على المساعدة

 انفس المطلوب ولكن غيرت مكان جلب البيانات وقمت بزيادة المتغيرات المجلوبة

test.rar

[عبدالله بشير عبدالله]

السلام عليكم

جرب المرفق  الاختيار من القائمة بالضغط مرتين على العتصر المختار واذا كان الرقم غير موجود تاتى رسالة بذلك 

بالتوفيق واي ملاحظات لا حرج في ذلك

test.xls

 

 

 

تم تعديل منذ 9 ساعات بواسطه عبدالله بشير عبدالله

[tahar]

ممكن شرح الكود  باللون الاخضر 

هل يمكن  اختيار من الليست بوكس بالضغط على انتري  واختيار بالفارة يعني تضيف خاصية اختيار بالضغط على انتري نزعها بايشاب   esc

عند مسح الخلية من رقم يجب ان لا تبقة المعلومات في الخلايا المجاورة

الكود في الارقام المكررة لا يجلب المتغيرات جرب الرقم 99

وشكرا

 

تم تعديل منذ 3 دقائق بواسطه tahar