اذهب الي المحتوي
أوفيسنا
بحث مخصص من جوجل فى أوفيسنا
Custom Search

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


إذهب إلى أفضل إجابة Solved by عبدالله بشير عبدالله,

الردود الموصى بها

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

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

 

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

تم تعديل بواسطه عبدالله بشير عبدالله
  • Like 1
رابط هذا التعليق
شارك

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

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

تحياتي

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

  • Like 1
رابط هذا التعليق
شارك

السلام عليكم

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

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

test.xls

 

 

 

تم تعديل بواسطه عبدالله بشير عبدالله
  • Like 2
رابط هذا التعليق
شارك

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

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

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

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

وشكرا

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

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

 

 

تم تعديل بواسطه tahar
رابط هذا التعليق
شارك

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

test.xls

 

تم تعديل بواسطه عبدالله بشير عبدالله
  • Like 1
رابط هذا التعليق
شارك

 

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

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

تم تعديل بواسطه tahar
رابط هذا التعليق
شارك

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

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

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

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

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

رابط هذا التعليق
شارك

  • أفضل إجابة

السلام عليكم

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

test (1) (1).xls

 

تم تعديل بواسطه عبدالله بشير عبدالله
رابط هذا التعليق
شارك

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

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

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

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

وشكرا جزيلا

تم تعديل بواسطه 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

 

  • Like 1
رابط هذا التعليق
شارك

من فضلك سجل دخول لتتمكن من التعليق

ستتمكن من اضافه تعليقات بعد التسجيل



سجل دخولك الان
  • تصفح هذا الموضوع مؤخراً   0 اعضاء متواجدين الان

    • لايوجد اعضاء مسجلون يتصفحون هذه الصفحه
×
×
  • اضف...

Important Information