تعديل كود بحث من عمودين بدل من عمود واحد فى اليوزر فورم

[ehabaf2]

السلام عليكم الاخوة الافاضل

كل عام و حضراتكم جميعا بالف خير و صحة و سعادة

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

الان يبحث فى العمود A فقط و يظهر كل الحقول بناء على رقم البحث فى العمود A

المطلوب اضافة كمبوبوكس يكون البحث عن طريق العمود A  و العمود B والعمود C يعني اختار قيمة من العمود A  وقيمة من العمود B وقيمة من العمود C  فيظهر سطر البحث  

مرفق الملف

الف الف شكر لحضراتكم

ترحيل مع كمبوبوكس البحث بحقلين).xlsm

[محمد هشام.]

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

 

 

ترحيل مع كمبوبوكس البحث بحقلين).xlsm

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

[ehabaf2]

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

التعديل ينفذ المطلوب وبشكل رائع

الف الف شكر لحضرتك ربنا يحقظك و يعزك و يزيدك علما و فضلا

[ehabaf2]

استاذنا الفاضل @محمد هشام.

هل ممكن  كنت محتاج تعديل من حضرتك لو امكن

ان الاستعلام يكون بالعمود A  و العمود B يعني الرقم و التاريخ و يستنتج العمود C فى الكومبوبوكس الثالث الخيارات المتاحة للبحث فى العمود C

و هل ممكن ان يكون العمود C عند الادخال يكون عداد بمعني عند تسجيل رقم 1 فى العمود A يكتب فى العمود C رقم 1 فى اول الادخال و عند الادخال الثانى عندما نكتب 1 يكون العمود C رقم 2  و هكذا عند ادخال الرقم فى العمود A يبداء العداد فى العمود C

الف الف شكر لحضرتك على مرورك الكريم و تعب حضرتك 

[محمد هشام.]

3 ساعات مضت, ehabaf2 said:

ان الاستعلام يكون بالعمود A  و العمود B يعني الرقم و التاريخ و يستنتج العمود C فى الكومبوبوكس الثالث الخيارات المتاحة للبحث فى العمود C

هدا ما تم الاشتغال عليه فعلا بحيث يكون البحث ديناميكيا بين جميع العناصر 1-2-3 بمعنى عند إختيار قيمة كومبوبوكس 1 يتم تعبئة كومبوبوكس 2 بالقيم المتاحة فقط وعند الإختيار من 2 يتم تعبئة كومبوبوكس 3 بالقيم المتاحة يشرط  1 و 2 فقط   لاحظ الصورة المتحركة مثلا عند اختيار رقم التسلسل 4 

3 ساعات مضت, ehabaf2 said:

و هل ممكن ان يكون العمود C عند الادخال يكون عداد بمعني عند تسجيل رقم 1 فى العمود A يكتب فى العمود C رقم 1 فى اول الادخال و عند الادخال الثانى عندما نكتب 1 يكون العمود C رقم 2  و هكذا عند ادخال الرقم فى العمود A يبداء العداد فى العمود C

طلبك غير واضح هل تقصد تسلسل للبيانات عند الترحيل او مادا 

[ehabaf2]

استاذنا الفاضل @محمد هشام.

الف شكر لتعب حضرتك

لكن عند تعبئة العنصر 1 ( عمود A ) يتم تعبئة العنصر 2 ( العمود C ) و ليس العمود B الذي يحتوى على التاريخ و هو المطلوب

بالنسبة لعمل عداد تلقائى 

العمود C عند الادخال يكون عداد بمعني عند تسجيل رقم 1 فى العمود A يكتب فى العمود C رقم 1 فى اول الادخال و عند الادخال الثانى عندما نكتب 1 يكون العمود C رقم 2  و هكذا عند ادخال الرقم فى العمود A يبداء العداد فى العمود C 

اقصد انه يزيد تلقائي بمقدار 1 عند تكرار الرقم فى العمود A و ثبات التاريخ المقابل له لهذا الرقم فى العمود B مرفق صورة توضح الفكرة

 

الف الف شكر لحضر و اسف على تعبك

[محمد هشام.]

25 دقائق مضت, ehabaf2 said:

لكن عند تعبئة العنصر 1 ( عمود A ) يتم تعبئة العنصر 2 ( العمود C ) و ليس العمود B الذي يحتوى على التاريخ و هو المطلوب

تمام ممكن نعدلها 

لاكن كود الترحيل يتضمن تسلسل للبيانات في عمود A ما يمنع تكرار القيم به هل ستقوم بحدفه وادخال التسلسل يدويا 

 

[ehabaf2]

نعم استاذتا الفاضل جميع الاعمدة تدخل يدوي عند الادخال و شكرا على تعبك و البيانات فى جميع الاعمدة ممكن تكرار البيانات

تم تعديل نوفمبر 3 بواسطه ehabaf2

[ehabaf2]

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

السلام عليكم و اعتزر عن الازعاج

اتمني حضرتك تكون شوفت طلبى الاخير  و لك جزيل الشكر

[محمد هشام.]

 

12 ساعات مضت, ehabaf2 said:

جميع الاعمدة تدخل يدوي عند الادخال و شكرا على تعبك و البيانات فى جميع الاعمدة ممكن تكرار البيانات

أخي @ehabaf2  أظن اننا بحاجة لإفراغ اليوزرفورم من جميع الأكواد السابقة وإعادة إظافة أكواد جديدة لتتناسب مع طلبك 

1) تعديل أعمدة تعبئة عناصر الكومبوبوكس

2) تعديل كود الترحيل للحصول على تسلسل عمود C (رقم الموظف) بداية من رقم 1 للقيمة الفريدة مع تسلسلها عند تكرار نفس المسلسل ونفس التاريخ

3) تعديل كود تحديث البيانات بحيث يتم تعديل الصف بشرط تطابق المسلسل والتاريخ ورقم الموظف (TEXTBOX1-TEXTBOX2-TEXTBOX3)

4) نفس الفكرة على كود الحدف  تفاديا لحدف أي بيانات لا تتطابق مع القيم المختارة بالعناصر  خاصة انها مكررة  (TEXTBOX1-TEXTBOX2-TEXTBOX3) وضمان إعادة التسلسل للشكل المطلوب 

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

لاكن ولا يهمك 

 بالنسبة لتعبئة عناصر الكومبوبوكس تم تعديلها على حسب طلبك كما في الصورة اسفله

 

كود الترحيل بعد  إظافة تسلسل عمود C بالشروط المدكورة 

Private Sub CommandButton1_Click()    'ترحيـل البيانات
    Dim i As Integer, lastRow As Long, choose As Integer
    Dim x As Integer, arr() As String, TexArr As String

    For i = 1 To 3
        If Me.Controls("TextBox" & i).Value = "" Then
            TexArr = Me.Controls("cnt" & i).Caption
            ReDim Preserve arr(x)
            arr(x) = TexArr
            x = x + 1
        End If
    Next i

    If x > 0 Then
        MsgBox "يرجى التحقق من " & Chr(10) & Join(arr, " - "), vbInformation
        Exit Sub
    End If

    choose = MsgBox("ترحيـل البيانات؟", vbYesNo, "تأكيـــد")
    If choose <> vbYes Then Exit Sub
    
    Application.ScreenUpdating = False
    lastRow = ws.Cells(ws.Rows.Count, 1).End(xlUp).Row + 1
    
     For i = 1 To 62
        If i <> 3 Then
            On Error Resume Next
            n = Me.Controls("TextBox" & i).Value
            On Error GoTo 0

            With ws.Cells(lastRow, i)
                If IsDate(n) Then
                    .Value = CDate(n)
                Else
                    .Value = n
                End If
            End With
        End If
    Next i
    Call UpdateNum(ws)
    For i = 1 To 62: Me.Controls("TextBox" & i).Value = "": Next i
    For i = 1 To 3: Me.Controls("ComboBox" & i).Value = "": Next i
    UserForm_Initialize
    Application.ScreenUpdating = True
End Sub

الدالة التالية لتسلسل عمود رقم الموظف سنقوم بإستدعائها  سواءا عند الترحيل أو الحدف وكدالك التعديل  لضمان الحفاظ على التسلسل الصحيح عند كل إجراء 

Function UpdateNum(ws As Worksheet) As Boolean
    On Error GoTo ErrorHandler
    Dim lastRow As Long, OnRng As Range
    Dim n() As Variant, ar() As Variant
    Dim src As Long, tmp As String
    Dim Dict As Object
    Set Dict = CreateObject("Scripting.Dictionary")
    
    lastRow = ws.Columns("A:B").Find(What:="*", SearchDirection:=xlPrevious, SearchOrder:=xlByRows).Row
    Set OnRng = ws.Range("A5:B" & lastRow)
    ar = OnRng.Value2
    
    ReDim n(1 To UBound(ar, 1), 1 To 1)
    
    For i = 1 To UBound(ar, 1)
        If ar(i, 1) <> "" And ar(i, 2) <> "" Then
            tmp = ar(i, 1) & "|" & ar(i, 2)
            
            If Not Dict.Exists(tmp) Then
                src = 1
                Dict.Add tmp, src
            Else
                src = Dict(tmp) + 1
                Dict(tmp) = src
            End If
            n(i, 1) = src
        Else
            n(i, 1) = ""
        End If
    Next i
    ws.Range("C5").Resize(UBound(n, 1), 1).Value = n
    UpdateNum = True
    Exit Function
ErrorHandler:
    UpdateNum = False
End Function

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

 

 

ترحيل مع كمبوبوكس البحث بحقلين V2.xlsm

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

[ehabaf2]

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

 

و الله لا اجد من الكلمات التى اعبر بها عن شكرى لحضرتك

الف الف شكر لحضرتك على تعبك و مجهودك 

ربنا يزيدك علما و يحفظك انت و اسرتك الكريمة

 

الكود ينفذ المطلوب بعد التعديل بكفأة عالية

تم تعديل نوفمبر 4 بواسطه ehabaf2

[ehabaf2]

الاستاذ الخلوق  @محمد هشام.

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

ده مشكله عندى فى الاوفيس و لا فيه خطأ 

و شكرا لحضرتك

[محمد هشام.]

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

في 3‏/11‏/2024 at 19:13, محمد هشام. said:

3) تعديل كود تحديث البيانات بحيث يتم تعديل الصف بشرط تطابق المسلسل والتاريخ ورقم الموظف (TEXTBOX1-TEXTBOX2-TEXTBOX3)

4) نفس الفكرة على كود الحدف  تفاديا لحدف أي بيانات لا تتطابق مع القيم المختارة بالعناصر  خاصة انها مكررة  (TEXTBOX1-TEXTBOX2-TEXTBOX3) وضمان إعادة التسلسل للشكل المطلوب

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

1) السؤال هل انت بحاجة لتعديل رقم المسلسل والتاريخ 

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

 

م	التاريخ	رقم الموظف	المنصب الوظيفي	تاريخ استلام المنصب	الشهادة بعد التعيين
					1	2
1	01-Oct	1	المنصب الوظيفي 1	استلام العمل1	شهادة 1	شهادة 2
1	01-Oct	2	المنصب الوظيفي 2	استلام العمل2	شهادة 2	شهادة 3
1	01-Oct	3	المنصب الوظيفي 3	استلام العمل3	شهادة 3	شهادة 4
3	01-Oct	1	المنصب الوظيفي 4	استلام العمل4	شهادة 4	شهادة 5
3	01-Oct	2	المنصب الوظيفي 5	استلام العمل5	شهادة 5	شهادة 6

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

[محمد هشام.]

بما أنك لم تجب عن سؤالي إليك طريقة أخرى ستقوم بإظافة عنصر جديد بإسم Line لإستخراج رقم صف المحدد عند الإختيار من عناصر الكومبوبوكس  وإعتمادا عليه سنقوم بتعديل وحدف الصفوف 

Private Sub SearchData()
    Dim fnd As Range
    Dim ColA As String, ColB As String, ColC As String
    Dim criteria As Range, found As Boolean
    Dim rowNum As Long

    ColA = Me.ComboBox1.Value
    ColB = Me.ComboBox2.Value
    ColC = Me.ComboBox3.Value

    If Len(ColA) = 0 Then Exit Sub

    Set criteria = WS.Range("A4:C" & WS.Cells(WS.Rows.Count, "A").End(xlUp).Row)
    found = False

    For Each fnd In criteria.Rows
        If fnd.Cells(1, 1).Value = ColA And _
           (ColB = "" Or Format(fnd.Cells(1, 2).Value, "dd-mmm") = ColB) And _
           (ColC = "" Or fnd.Cells(1, 3).Value = ColC) Then
            For i = 1 To 62
                Me.Controls("TextBox" & i).Value = fnd.Cells(1, i).Value
            Next i
            
            rowNum = fnd.Row
            found = True
            Exit For
        End If
    Next fnd

    If Not found Then
        ClearTextBoxes
        Me.Line.Value = ""
    Else
        Me.Line.Value = rowNum
    End If
End Sub

 

 

Private Sub CommandButton2_Click()
    Dim r As Integer, n As Variant
    Dim i As Integer, X As Integer
    Dim rowNum As Long, fnd As Range

    If IsNumeric(Me.Line.Value) Then
        rowNum = CLng(Me.Line.Value)
    Else
        MsgBox " يرجى تحديدالبيانات المرغوب تعديلها", vbExclamation
        Exit Sub
    End If

    If rowNum < 5 Then: Exit Sub
   If SaisieText(1, 2) Then Exit Sub

    r = MsgBox("تعديل البيانات؟", vbYesNo, "تأكيـــد")
    If r <> vbYes Then Exit Sub

    Application.ScreenUpdating = False
    Set fnd = WS.Cells(rowNum, 1)
    For i = 1 To 62
        On Error Resume Next
        n = Me.Controls("TextBox" & i).Value
        On Error GoTo 0
        If IsDate(n) Then
            fnd.Offset(0, i - 1).Value = CDate(n)
        Else
            fnd.Offset(0, i - 1).Value = n
        End If
    Next i

    Call UpdateNum(WS)
    Clear_TextBox
    UserForm_Initialize
    Application.ScreenUpdating = True
    MsgBox "تم التعديل بنجاح", vbInformation
End Sub

 

Private Function SaisieText(startIdx As Integer, endIdx As Integer) As Boolean
    Dim i As Integer, X As Integer
    Dim arr() As String, TexArr As String
    For i = startIdx To endIdx
        If Me.Controls("TextBox" & i).Value = "" Then
            TexArr = Me.Controls("cnt" & i).Caption
            ReDim Preserve arr(X)
            arr(X) = TexArr
            X = X + 1
        End If
    Next i
    If X > 0 Then
        MsgBox ": يرجى التحقق من " & Chr(10) & Join(arr, " - "), vbInformation
        SaisieText = True
    Else
        SaisieText = False
    End If
End Function

 

ترحيل مع كمبوبوكس البحث بحقلين V3.xlsm

[ehabaf2]

الاستاذ الخلوق @محمد هشام.

الف الف شكر لحضرتك و الله تعبتك و انت دائما لاتبخل بالمساعدة 

اكرر شكرى لحضرتك

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