مطلوب تعديل محتوى الليست بوكس

[عادل ابوزيد]

السلام عليكم

الملف يحتوى على فورم يقوم بالبحث والاضافة والتعديل والانتقال بين الصفوف حسب اختيارك للبيانات فى الليست بوكس .. المطلوب : هناك مشكلتين :

الاولى : بيانات الليست بوكس غير متفقه مع بيانات الشيت ... ولقد اكتشفت السبب وهو ان عمود المسلسل مرتبط بالتاريخ بمعنى ان المسلسل يبدا من 1 مع بداية كل شهر ويوبنتهى بنهاية الشهر ثم يبدا من جديد ببداية شهر جديد وهكذا وبالتالى عندما يتم استدعاء البيانات فى الليست بوكس بيانات مسلسل مثلاً 18 فى شهر 8 للاسف هى بيانات شهر 7 ( بداية التسلسل شهر 7 فى العمود  ) وبالتالى عند تحديد اىو بيان فى شهر 8 او 9 او 10 سيتم تحديد نظيره فى شهر 7 

الثانية : تنسيق اعمدة التاريخ فى الليست بوكس و وتنسيق بيانات التيكست بوكس  الخاصة بالتاريخ مطلوب تنسيقها   كالآتى :  يوم / شهر / سنة

تعديل فورم.rar

[alliiia]

وعليكم السلام ورحمة الله وبركاته

تفضل مطلوبك

وبالتوفيق

تعديل فورم.7z

[محمد هشام.]

وعليكم السلام ورحمة الله تعالى وبركاته

Option Compare Text
Dim f, Rng, wsData()
Private Sub UserForm_Initialize()
    Dim f As Worksheet, Rng As Range
    Dim wsData As Variant, i As Long
    Set f = Sheets("البداية")
    Set Rng = f.Range("C7:N" & f.Cells(f.Rows.Count, "E").End(xlUp).row) 
    wsData = Rng.Value
    For i = LBound(wsData, 1) To UBound(wsData, 1)
        Dim j As Long
        For j = 2 To 11
            If IsDate(wsData(i, j)) Then wsData(i, j) = Format(wsData(i, j), "yyyy/mm/dd")
        Next j
    Next i
    With ListBox1
        .ColumnWidths = "35;70;65;100;110;65;70;75;70;70;70;100"
        .ColumnCount = 12: .Font.Size = 9: .Font.Name = "Mudir MT"
        .List = wsData
    End With
    With ComboBox1
        .AddItem "رقم الملف": .AddItem "الفاحص": .AddItem "اسم المراجع"
    End With
'Code.............
End Sub

 

Private Sub ListBox1_Click()
    Dim i As Byte, Rng As Long
    Dim Colstar As Integer, ColEnd As Integer
    Dim ws As Worksheet:    Set ws = Sheets("البداية")
    Colstar = 4: ColEnd = 14

    If ListBox1.ListIndex = -1 Then
        MsgBox "يرجى اختيار صف من القائمة", vbExclamation
        Exit Sub
    End If

    For i = 0 To 11
        If IsDate(ListBox1.Column(i)) Then
            Controls("TextBox" & i + 1).Value = Format(ListBox1.Column(i), "yyyy/mm/dd")
        Else
            Controls("TextBox" & i + 1).Value = ListBox1.Column(i)
        End If
    Next i

    TextBox15.Value = ListBox1.ListIndex + 1
    Rng = ListBox1.ListIndex + 7
    
    With ws
        .Activate
        .Range(.Cells(Rng, Colstar), .Cells(Rng, ColEnd)).Select
    End With
End Sub

 

 

تعديل فورم.rar

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

[عادل ابوزيد]

السلام عليكم ورحمه الله وبركاته

الاساتذة الافاضل اشكر شحصكم الكريم على الاستجابة لموضوعى واسمحوا لى بملاحظة الآتى :

 

عند اختبار البرنامج بعد التعديل عند تنفيذ تعديل فى بيان خاص بشهر 9 مثلاً للاسف يتم تعديل المناظر له فى شهر 7 

بمعنى تم اختيار المسلسل رقم 510 فى شهر 9 وتم تعديل البيان وعند الضغط على تعديل البيان .. تبين انه قام البرنامج بتعديل المسلسل رقم 510 فى شهر 7 كاملاً ولم يتم تعديل البيان المناظر له فى شهر 9

تقبلوا شكرى وتقديرى

[محمد هشام.]

 

Function irow(ws As Worksheet, tmp As String) As Long
    Dim lastrow As Long, i As Long
    lastrow = ws.Cells(ws.Rows.Count, "E").End(xlUp).row
    For i = 7 To lastrow
        If ws.Cells(i, 5).Value = tmp Then
            irow = i
            Exit Function
        End If
    Next i
    irow = -1
End Function

تعديل 

Private Sub CommandButton2_Click()
    Dim ws As Worksheet, linge As Long, i As Long
    Dim ColArr As Variant, arr() As Variant
    Set ws = ThisWorkbook.Sheets("البداية")
    Dim tmp As String: tmp = Me.TextBox3.Value
    
    If tmp = "" Then: MsgBox "الرجاء إدخال رقم الملف", vbExclamation, "خطأ": Exit Sub
    
    linge = irow(ws, tmp)
    If linge = -1 Then: MsgBox "رقم الملف غير موجود", vbExclamation, "خطأ": TextBox3.SetFocus: Exit Sub
  
    If MsgBox("هل أنت متأكد أنك تريد تعديل بيانات " & Me.TextBox4.Value & "؟", vbYesNo + vbQuestion, "تأكيد") = vbYes Then
        
        ColArr = Array("C", "D", "E", "F", "G", "H", "I", "J", "K", "L", "M", "N")
        
        arr = Array(Me.TextBox1.Value, Me.TextBox2.Value, Me.TextBox3.Value, _
                    Me.TextBox4.Value, Me.TextBox5.Value, Me.TextBox6.Value, _
                    Me.TextBox7.Value, Me.TextBox8.Value, Me.TextBox9.Value, _
                    Me.TextBox10.Value, Me.TextBox11.Value, Me.TextBox12.Value)
                    
        Application.ScreenUpdating = False
        For i = LBound(arr) To UBound(arr)
            If i <= UBound(ColArr) Then
                ws.Cells(linge, ColArr(i)).Value = arr(i)
            End If
        Next i
     
    UserForm_Initialize
    Application.ScreenUpdating = True

        MsgBox "تم تعديل البيانات بنجاح", vbInformation
    End If
End Sub

ترحيل

Private Sub CommandButton1_Click()
    Dim ws As Worksheet, lastrow As Long
    Dim arr() As Variant, ColArr As Variant, tmp As String

    Set ws = ThisWorkbook.Sheets("البداية")
    lastrow = ws.Cells(ws.Rows.Count, "E").End(xlUp).row
    tmp = Me.TextBox3.Value

    If tmp = "" Then MsgBox "الرجاء إدخال رقم الملف", vbExclamation, "خطأ": Exit Sub
    If TextBox4.Value = "" Then MsgBox "يرجى ادخال اسم صاحب المعاش", vbExclamation: TextBox4.SetFocus: Exit Sub
    If TextBox6.Value = "" Then MsgBox "يرجى ادخال اسم الفاحص", vbExclamation: TextBox6.SetFocus: Exit Sub

    If WorksheetFunction.CountIf(ws.Range("E7:E" & lastrow), tmp) > 0 Then
        MsgBox "رقم الملف موجود بالفعل", vbExclamation, "تكرار رقم الملف": Exit Sub
    End If

    ColArr = Array("C", "D", "E", "F", "G", "H", "I", "J", "K", "L", "M", "N")
    arr = Array(Me.TextBox1.Value, Me.TextBox2.Value, tmp, TextBox4.Value, _
                Me.TextBox5.Value, TextBox6.Value, Me.TextBox7.Value, _
                Me.TextBox8.Value, Me.TextBox9.Value, Me.TextBox10.Value, _
                Me.TextBox11.Value, Me.TextBox12.Value)

    Application.ScreenUpdating = False
    For i = LBound(arr) To UBound(arr)
        ws.Cells(lastrow + 1, ColArr(i)).Value = arr(i)
    Next i

    With ws.Range("C7:C" & ws.Cells(ws.Rows.Count, "D").End(xlUp).row)
        .Value = Evaluate("ROW(" & .Address & ")-6")
    End With

    For Each ctrl In Me.Controls
        If TypeName(ctrl) = "TextBox" Then ctrl.Value = ""
    Next ctrl
    UserForm_Initialize
    Application.ScreenUpdating = True
    MsgBox "تم إدخال البيانات بنجاح", vbInformation, "نجاح"
End Sub

 

تعديل فورم.rar

[عادل ابوزيد]

السلام عليكم ورحمه الله وبركاته

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

اولاً : الملاحظات المطلوب حل لها 

1 - عند اجراء البحث تكون النتيجة حالة او اكثر عند الضغط عليها فى الليست بوكس يتم تحديد اول او ثانى صف  فى الشيت حسب ترتيبه فى الليست بوكس وليس الصف المتواجد فيه نتيجة البحث فى الشيت

2 - عمود المسلسل اصبح مثل عمود الوارد من واحد حتى اخر رقم مسلسلى .. مع العلم انه المفروض يبدا من واحد مع كل بداية شهر بمعنى التاريخ فى اول الشهر يوليو يبدا المسلسل من 1 التاريخ فى ابو شهر اغسطس يبدا من 1 ... فإذا كان هذا هو المطلوب ولا يوجد بديل لذلك ، فأقترح ادخال عمود الوارد فى تنفيذ الكود مع عدم ظهوره فى الليست بوكس او عند تعديل البيانات حتى نحافظ على الهدف من وجود عمود المسلسل

ثانياً : الملاحظات التى تم حلها .. برجاء مراجعتها حتى تتعارض مع اى اوامر اخرى داخل الكود

1 - مع كل اجراء تعديل فى البيانات لصف  يتم تكرار بيانات الكمبوبوكس الموجوده فى جزء البحث

2 - عند الضغط على تفريغ خلية البحث يتم استعراض بيانات الشيت بدون التنسيقات المطلوبة 

 

والمرفق به حل للملاحظتين فقط

تعديل فورم_بتعديل جزئى.rar

تم تعديل أكتوبر 29 بواسطه عادل ابوزيد

[محمد هشام.]

23 ساعات مضت, عادل ابوزيد said:

رتيبه فى الليست بوكس وليس الصف المتواجد فيه نتيجة البحث فى الشيت

Private Sub ListBox1_Click()
    Dim i As Byte, Clé As Variant
    Dim WS As Worksheet, ColF As Range
    Dim Colstar As Integer, ColEnd As Integer

    Set WS = Sheets("البداية")
    
    Colstar = 3
    ColEnd = 14
    

    For i = 0 To 11
        Controls("TextBox" & (i + 1)).Value = IIf(ListBox1.ListIndex <> -1, ListBox1.Column(i), "")
    Next i
   Clé = TextBox4.Value
    Set ColF = WS.Columns("F").Find(What:=Clé, LookIn:=xlValues, LookAt:=xlWhole)
    If Not ColF Is Nothing Then
        WS.Activate
        WS.Range(WS.Cells(ColF.row, Colstar), WS.Cells(ColF.row, ColEnd)).Select
    End If
End Sub

 

23 ساعات مضت, عادل ابوزيد said:

مع كل اجراء تعديل فى البيانات لصف  يتم تكرار بيانات الكمبوبوكس الموجوده فى جزء البحث

 With ComboBox1
      .Clear
        .AddItem "رقم الملف": .AddItem "الفاحص": .AddItem "اسم المراجع"
   End With

 

23 ساعات مضت, عادل ابوزيد said:

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

UserForm_Initialize
TextBox13.Value = "": ComboBox1.Value = ""
Label15.Caption = ""

 

 

تعديل فورم.rar

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

[عادل ابوزيد]

السلام عليكم 

استاذى الفاضل .. اسمح لى بتوضيح الملحوظة الاولى بارسال صورتين مرة عدد نتائج البحث نتيحة واحدة والاخرى عدد نتائج البحث اكثر من نتيجة .. مع ملاحظة مكان التحديد فى الليست والشيت

تقبل شكرى وامنتانى لمجهودكم الوفير واهتمامك 

[عادل ابوزيد]

الملف المقتبس منه.xls

[محمد هشام.]

أعتدر أخي @عادل ابوزيد  خطأ لم انتبه له😂   الكود ينفد طلبك لاكن يجب وضع قيمة البحث بعد الصف الخاص بنقل البيانات لعناصر التيكست بهدا الشكل ليس قبلها  

للتوضيح 

1)  الفكرة انه يقوم بتحديد الصف بناءا على قيمة textbox4  في عمود ( F ) اسم صاحب المعاش  يمكنك تعديلها بما يناسبك 

For i = 0 To 11
        Controls("TextBox" & (i + 1)).Value = IIf(ListBox1.ListIndex <> -1, ListBox1.Column(i), "")
    Next i
   Clé = TextBox4.Value

 

2)  في حالة كانت لديك أسماء مكررة يمكنك اظافة شروط اخرى كما في المثال التالي بحيث سنعتمد على اسم  صاحب المعاش و رقم الملف وعند التحقق من تطابق الشرطين سيتم تحديد الصف وفي حالة وجود تكرار  لنفس البيانات سيقوم بتحديد جميع الصفوف المكررة 

يمكنك تحميل الملف في المشاركة السابقة بعد تصحيح الخطأ وإختيار ما يناسبك 

Private Sub ListBox1_Click()
    Dim ws As Worksheet, OnRng As Range, ColFind As Range
    Dim Colstar As Integer, ColEnd As Integer, n As Long
    Dim Clé As Variant, Clé2 As Variant, tmp As Range, f As String, i As Byte

    Set ws = Sheets("البداية")
    
    Colstar = 3: ColEnd = 14
    
    For i = 0 To 11
        Controls("TextBox" & (i + 1)).Value = ListBox1.Column(i)
    Next i

    TextBox15.Value = ListBox1.ListIndex + 1
    Clé = TextBox4.Value: Clé2 = TextBox3.Value
    
    Set tmp = Nothing
    n = 0

    Set OnRng = ws.Range(ws.Cells(7, "F"), ws.Cells(ws.Rows.Count, "F").End(xlUp))
    Set ColFind = OnRng.Find(Clé, LookIn:=xlValues, LookAt:=xlWhole)

    If Not ColFind Is Nothing Then
        f = ColFind.Address
        Do
            If ws.Cells(ColFind.row, "E").Value = Clé2 Then
                n = n + 1
                If tmp Is Nothing Then
                    Set tmp = ColFind.EntireRow
                Else
                    Set tmp = Union(tmp, ColFind.EntireRow)
                End If
            End If
            
            Set ColFind = OnRng.FindNext(ColFind)
        Loop While Not ColFind Is Nothing And ColFind.Address <> f
    End If

    If n > 0 Then
        On Error Resume Next
        ws.Activate
        If Not tmp Is Nothing Then
            Dim rng As Range
            For Each row In tmp.Rows
                If rng Is Nothing Then
                    Set rng = ws.Range(ws.Cells(row.row, Colstar), ws.Cells(row.row, ColEnd))
                Else
                    Set rng = Union(rng, ws.Range(ws.Cells(row.row, Colstar), ws.Cells(row.row, ColEnd)))
                End If
            Next row
            rng.Select
        End If
        On Error GoTo 0
    End If
End Sub

 

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

[عادل ابوزيد]

استاذى الفاضل 

تحية شكر وتقدير على مجهودك الكبير وحلولك الرائعة

بناء على توضيح حضرتك من حيث تكرار البيانات فعلاً البيانات مكررة ولكن للاسف سواء لرقم الملف او لاسم صاحب المعاش انها مرتبطه ببعض بمعنى ان لكل صاحب معاش رقم ملف خاص به ولكن قد يتكرر التعامل مع الملف وبالتالى الاسم اكثر من مرة ولذلك اقترحت ( لانى استنتجت هذا الربط فى الكود ) بان يكون العمل على عمود لا يتكرر فيه البيان وهذا العمود هو عمود الوارد لانه لن ولم يتكرر عكس المسلسل يتكرر فى الشهور بمعننى موجود فى شهر 7 وشهر 8 وشهر 9 وشهر 10 وهكذا

اقتراح لعلاج ذلك : وضع شروط للتساوى هو تطابق رقم الوارد مع رقم الملف مع اسم صاحب المعاش ( وعدم الاكتفاء بالرقم وصاحب المعاش )

                 الافتراح الثانى : فما رايك بإدخال عمود الوارد فى الكود مع عدم اظهاره فى الليست .. ينفع ام لا ؟؟

تقبل تحياتى

مع العلم  بالتطبيق فى الملف الاخير وبالبحث وعند التعديل تبين ان التعديل يتم تنفيذه فى الصف الاول فى الشيت الذى به نفس البيانات كما بالمثال

تم تعديل أكتوبر 30 بواسطه عادل ابوزيد

[محمد هشام.]

نعم اخي المشكلة في طريقة البحث التي تستخدمها  لهدا سنعتمد على طريقة متقدمة نوعا ما لتنفيد طلبك  وتحديد الصف بدون الاعتماد على إسم او رقم الملف

  مع اظافة إمكانية البحث والفلترة بأي عمود 

Private Sub ListBox1_Click()
Dim lastRow As Long: lastRow = f.Rows.Count
f.Range("A7:A" & lastRow).Interior.ColorIndex = xlNone

    For i = 1 To OnRng
        Me("textbox" & i) = Me.ListBox1.Column(i - 1)
    Next i
    Me.N_ligne = Me.ListBox1.Column(i - 1)
   
    rng = Me.N_ligne + 6

    If rng > 0 Then
     
        With f
            .Range(.Cells(rng, "C"), .Cells(rng, "N")).Select
            .Cells(rng, "A").Interior.Color = RGB(0, 0, 255)
        End With

    End If
End Sub

 

 

تعديل فورم V5 -.rar

تم تعديل نوفمبر 1 بواسطه محمد هشام.

[عادل ابوزيد]

استاذى الفاضل 

تسلم ايدك .. بس هل هناك حل لنحافظ على عمود المسلسل ( نفس الملحوظة فى المشاركة السابقة مباشرة ) 

المسلسل ده بيتم كتابته فى سجل ورقى ويتم كتابته على الملف نفسه حتى يسهل العثور عليه فى السجل لتسجيل الاجراء ورقياً .. وده الهدف من المسلسل

حفظكم الله ورعاكم وزادكم من نعمه وفضله

[محمد هشام.]

نعم التعديل والاظافة ليس لها علاقة بالمسلسل انت من تضيفه يدويا فقط يتم فقدانه في حالة حدف الصف 

[عادل ابوزيد]

والبحث هل له علاقة 

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

[محمد هشام.]

لا علاقة له بالمسلسل التحديد يتم بواسطة رقم الصف 

 

 

[mahmoud nasr alhasany]

احسنت ا /  محمد هشام عمل رائع

تم تعديل نوفمبر 1 بواسطه mahmoud nasr alhasany

[عادل ابوزيد]

تم تعديل رقم المسلسل

ممكن بعد اذنك لو تكرمت اضافة رؤوس الاعمدة بالليست بوكس ..  على ان يتم العمل على يوزرفورم 7

تعديل فورم V5 -.rar

تم تعديل نوفمبر 1 بواسطه عادل ابوزيد

[محمد هشام.]

ربما هدا ما تقصده 

 

 

تعديل فورم V6 -.rar

تم تعديل نوفمبر 2 بواسطه محمد هشام.

[عادل ابوزيد]

استاذى الفاضل محمد هشام

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

زادكم الله من فضله وكرمه وجعله فى ميزان حسناتك .. لا اجد كلمات تعبير عن مشاعرى واعجابى باخلاصكم وتعاونكم معنا خير من الدعاء فاللهم تقبل يا رب العالمين