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

[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

تم تعديل سبتمبر 25 بواسطه عبدالله بشير عبدالله

[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

تم تعديل سبتمبر 26 بواسطه tahar

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

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

[tahar]

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

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

test.rar

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

السلام عليكم

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

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

test.xls

 

 

 

تم تعديل سبتمبر 28 بواسطه عبدالله بشير عبدالله

[tahar]

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

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

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

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

وشكرا

عند اختيار الرقم 99 المتكرر لا تتغير البيانات 

اخنيار المقاطعات من ليست بوكس بالفارة از زر انتري ونزع قائمى ليست بوكس بزر esc

 

 

تم تعديل سبتمبر 28 بواسطه tahar

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

تم التعديل يمكن الاختيار بالفارة ويمكنك الخروج عن طريق علامة × في الفورم

test.xls

 

تم تعديل سبتمبر 29 بواسطه عبدالله بشير عبدالله

[tahar]

 

 شكرا   تم حل مشكل جلب البيانات في حال تكرار 

الرجاء ارجاع خاصية  الصعود والنزول بالاسهم والاختيار  بالانتري   و غلق الفورم. ب ايشاب Esc.  

تم تعديل سبتمبر 29 بواسطه tahar

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

تم التعديل

test (1).xls

[tahar]

 شكرا. ارجو المعذرة تعبتك معايا

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

اما الأشياء الأخرى كلها تعمل بكفاءة 

عند اختيار رقم المقاطعة المكرر  لا تنجح المعادلة ممكن تعديل

بقي مشكل واحد وهو في حالة اختيار رقم مقاطعة غير مكرر تضهر نتيجة مباشرة بدون اختيار من ليست بوكس  وشكراةعلى المساعدة

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

السلام عليكم

 اعدرنى على التاخير 

test (1) (1).xls

 

تم تعديل أكتوبر 2 بواسطه عبدالله بشير عبدالله

[tahar]

شكرا جزيلا وجزاء الله كل خير  انا اعتذر على كثرة التسؤلات وجعلها الله في ميزان حسناتها

01-ممكن شرح اجزاء الكود ---داخل الكود باللون الاخضر--

02-واين اعدل في حالة أضفت عمود متغير في ورقة mokata

او اضفت عمود في الورقة res قبل رقم المقاطعة او بعده

وشكرا جزيلا

تم تعديل أكتوبر 3 بواسطه tahar

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

تفضل شرح الكود

اما اذا تم اظافة اعمدة فربما شرح الكود بقيدك بطريقة التعديل او يمكنك حينها فنح موضوع جديد بالمنتدى وتقديم سؤالك  بالتوفيق  

Private Sub Worksheet_Change(ByVal Target As Range)
    ' تعريف المتغيرات
    Dim wsRes As Worksheet ' ورقة العمل "res"
    Dim wsMokata As Worksheet ' ورقة العمل "mokata"
    Dim districtNumber As String ' الرقم المدخل في العمود F
    Dim lastRowMokata As Long ' آخر صف يحتوي على بيانات في عمود A في ورقة "mokata"
    Dim dataRange As Range ' النطاق الذي سيتم البحث فيه عن الرقم المدخل
    Dim foundCount As Integer ' عداد لعدد المرات التي يظهر فيها الرقم المدخل
    Dim cell As Range ' متغير ليمثل كل خلية في نطاق البحث
    
    ' ربط المتغيرات بأوراق العمل
    Set wsRes = ThisWorkbook.Sheets("res")
    Set wsMokata = ThisWorkbook.Sheets("mokata")
    
    ' يتم تجاهل الأخطاء لمنع تعطل الكود في حال حدوث خطأ
    On Error Resume Next
    
    ' التحقق مما إذا كانت الخلية التي تم تغييرها هي في العمود F من ورقة "res"
    If Not Intersect(Target, wsRes.Range("F:F")) Is Nothing Then
        districtNumber = Trim(CStr(Target.Value)) ' الحصول على الرقم المدخل مع إزالة المسافات الفارغة

        'f اً إذا تم مسح الخلية في العمود، يتم مسح المحتويات في الأعمدة المجاورة (G, H, I)
        If districtNumber = "" Then
            Target.Offset(0, 1).Resize(1, 3).ClearContents
        Else
            ' تحديد آخر صف يحتوي على بيانات في عمود A في ورقة "mokata"
            lastRowMokata = wsMokata.Cells(wsMokata.Rows.Count, "A").End(xlUp).Row
            ' تحديد نطاق البحث عن الرقم المدخل
            Set dataRange = wsMokata.Range("A5:A" & lastRowMokata)

            foundCount = 0 ' تهيئة عداد المرات التي يظهر فيها الرقم المدخل
            
            ' البحث في النطاق عن الرقم المدخل وعدّ المرات التي يظهر فيها
            For Each cell In dataRange
                If Trim(CStr(cell.Value)) = districtNumber Then
                    foundCount = foundCount + 1
                End If
            Next cell

            ' إذا تم العثور على الرقم مرة واحدة فقط
            If foundCount = 1 Then
                For Each cell In dataRange
                    ' العثور على الصف الذي يحتوي على الرقم المدخل
                    If Trim(CStr(cell.Value)) = districtNumber Then
                        ' نقل البيانات من الأعمدة 2, 3, 4 في ورقة "mokata" إلى الأعمدة G, H, I في ورقة "res"
                        Target.Offset(0, 1).Value = wsMokata.Cells(cell.Row, 2).Value ' العمود G
                        Target.Offset(0, 2).Value = wsMokata.Cells(cell.Row, 3).Value ' العمود H
                        Target.Offset(0, 3).Value = wsMokata.Cells(cell.Row, 4).Value ' العمود I
                        Exit For ' الخروج من الحلقة بعد العثور على القيمة
                    End If
                Next cell
            ' إذا تم العثور على الرقم أكثر من مرة
            ElseIf foundCount > 1 Then
                Dim districtList As String ' سلسلة لتخزين القيم المرتبطة بالرقم المدخل
                districtList = ""
                
                ' جمع القيم المرتبطة بالرقم المدخل
                For Each cell In dataRange
                    If Trim(CStr(cell.Value)) = districtNumber Then
                        districtList = districtList & wsMokata.Cells(cell.Row, 4).Value & "," ' إضافة القيمة إلى السلسلة
                    End If
                Next cell

                ' إذا تم العثور على قيم، يتم إعداد واجهة المستخدم (UserForm) لعرض هذه القيم
                If Len(districtList) > 0 Then
                    districtList = Left(districtList, Len(districtList) - 1) ' إزالة الفاصلة الزائدة في نهاية السلسلة
                    UserForm1.ListBox1.Clear ' مسح القائمة السابقة في ListBox
                    UserForm1.ListBox1.List = Split(districtList, ",") ' تقسيم السلسلة ووضع القيم في ListBox
                    
                    ' ربط الخلية التي تم تغييرها مع النموذج
                    Set UserForm1.TargetCell = Target
                    UserForm1.Show ' عرض النموذج للمستخدم لاختيار قيمة
                End If
            Else
                ' إذا لم يتم العثور على الرقم، يتم عرض رسالة تحذير
                MsgBox "لا توجد بيانات مرتبطة بهذا الرقم.", vbExclamation
            End If
        End If
    End If
End Sub

 

[tahar]

شكرا وجزاء الله كل خير وجعلها الله في ميزان حسناتكم 

[tahar]

سلام ممكن تعديل على الكود للاختيار ب الانتري وتختفي الفورم ددون استعمال esc

,والرجاء توضيح مكان التعديل في الكود

مقاطعة.rar

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

تم التعديل

مكان التعديل 

        Case vbKeyEscape ' زر Esc
لم اقم بحذفها وانما قمت بتعليق او تجميد مهمتها باظافة فاصلة 

       ' Case vbKeyEscape ' زر Esc
يمكن حذف القاصلة المظاقة لتفعيلها

مقاطعة.xls

 

[tahar]

شكرا جزيلا جزاك الله كل خير