مساعدة فى كود البحث

[235Waheed]

السلام عليكم محتاج تعديل لكود البحث بحيث 

ان ال id فى خليتين مدمجه وامامه خانة ساعات العمل واسفلها خانت السلف

هل ينفع الكود المستخدم فى جلب مثلا خلية من (d3:z3) ,وللسلف من (d4:z4)

lr = WorksheetFunction.CountIf(Range("A2:A1000"), Val(TextBox1.Value))

If TextBox1.Value <> "" And lr = 1 Then
TextBox2.Value = WorksheetFunction.VLookup(Val(TextBox1.Value), Range("A2:r1000"), 2, 0)
TextBox4.Value = WorksheetFunction.VLookup(Val(TextBox1.Value), Range("A2:r1000"), 4, 0)
TextBox5.Value = WorksheetFunction.VLookup(Val(TextBox1.Value), Range("A2:r1000"), 5, 0)
TextBox6.Value = WorksheetFunction.VLookup(Val(TextBox1.Value), Range("A2:r1000"), 6, 0)
TextBox7.Value = WorksheetFunction.VLookup(Val(TextBox1.Value), Range("A2:r1000"), 7, 0)
TextBox8.Value = WorksheetFunction.VLookup(Val(TextBox1.Value), Range("A2:r1000"), 8, 0)
TextBox9.Value = WorksheetFunction.VLookup(Val(TextBox1.Value), Range("A2:r1000"), 9, 0)
TextBox10.Value = WorksheetFunction.VLookup(Val(TextBox1.Value), Range("A2:r1000"), 10, 0)
TextBox11.Value = WorksheetFunction.VLookup(Val(TextBox1.Value), Range("A2:r1000"), 11, 0)
TextBox12.Value = WorksheetFunction.VLookup(Val(TextBox1.Value), Range("A2:r1000"), 12, 0)
TextBox13.Value = WorksheetFunction.VLookup(Val(TextBox1.Value), Range("A2:r1000"), 13, 0)
TextBox14.Value = WorksheetFunction.VLookup(Val(TextBox1.Value), Range("A2:r1000"), 14, 0)
TextBox15.Value = WorksheetFunction.VLookup(Val(TextBox1.Value), Range("A2:r1000"), 15, 0)
TextBox16.Value = WorksheetFunction.VLookup(Val(TextBox1.Value), Range("A2:r1000"), 16, 0)
TextBox17.Value = WorksheetFunction.VLookup(Val(TextBox1.Value), Range("A2:r1000"), 17, 0)
TextBox18.Value = WorksheetFunction.VLookup(Val(TextBox1.Value), Range("A2:r1000"), 18, 0)
TextBox19.Value = WorksheetFunction.VLookup(Val(TextBox1.Value), Range("A2:AL1000"), 35, 0)
TextBox20.Value = WorksheetFunction.VLookup(Val(TextBox1.Value), Range("A2:AL1000"), 36, 0)
TextBox21.Value = WorksheetFunction.VLookup(Val(TextBox1.Value), Range("A2:AL1000"), 37, 0)

Else
TextBox2.Value = ""
TextBox4.Value = ""
TextBox5.Value = ""
TextBox6.Value = ""
TextBox7.Value = ""
TextBox8.Value = ""
TextBox9.Value = ""
TextBox10.Value = ""
TextBox11.Value = ""
TextBox12.Value = ""
TextBox13.Value = ""
TextBox14.Value = ""
TextBox15.Value = ""
TextBox16.Value = ""
TextBox17.Value = ""
TextBox18.Value = ""
TextBox19.Value = ""
TextBox20.Value = ""
TextBox21.Value = ""
End If

 

‏‏كشف حدادين 2021 (8) - نسخة.xlsm

[حسونة حسين]

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

تفضل اخى الكريم ان شاء الله يكون طلبك

ضع هذا الكود في ملفك في userform1  بدل الأكواد الموجوده 

Private Sub CommandButton1_Click()

    For x = 2 To Cells(Rows.Count, "A").End(xlUp).Row
        If Cells(x, 1) = TextBox1.Text Then
            Cells(x, 4) = TextBox4.Text
            Cells(x, 5) = TextBox5.Text
            Cells(x, 6) = TextBox6.Text
            Cells(x, 7) = TextBox7.Text
            Cells(x, 8) = TextBox8.Text
            Cells(x, 9) = TextBox9.Text
            Cells(x, 10) = TextBox10.Text
            Cells(x, 11) = TextBox11.Text
            Cells(x, 12) = TextBox12.Text
            Cells(x, 13) = TextBox13.Text
            Cells(x, 14) = TextBox14.Text
            Cells(x, 15) = TextBox15.Text
            Cells(x, 16) = TextBox16.Text
            Cells(x, 17) = TextBox17.Text
            Cells(x, 18) = TextBox18.Text
        Exit For
        End If
    Next x
End Sub
Private Sub CommandButton2_Click()
UserForm1.Hide
UserForm2.Show
End Sub

Private Sub CommandButton3_Click()
sheet1.Activate
UserForm1.Hide
End Sub

Private Sub CommandButton4_Click()
UserForm1.Hide
sheet3.Activate
UserForm4.Show
End Sub
Private Sub TextBox1_Change()
Dim x
For x = 3 To Cells(Rows.Count, "A").End(xlUp).Row
If TextBox1.Text = Cells(x, 1) And TextBox1.Value <> "" Then
    TextBox2.Value = Cells(x, "b").Value
    TextBox4.Value = Cells(x, "d").Value
    TextBox5.Value = Cells(x, "e").Value
    TextBox6.Value = Cells(x, "f").Value
    TextBox7.Value = Cells(x, "g").Value
    TextBox8.Value = Cells(x, "h").Value
    TextBox9.Value = Cells(x, "i").Value
    TextBox10.Value = Cells(x, "j").Value
    TextBox11.Value = Cells(x, "k").Value
    TextBox12.Value = Cells(x, "l").Value
    TextBox13.Value = Cells(x, "m").Value
    TextBox14.Value = Cells(x, "n").Value
    TextBox15.Value = Cells(x, "o").Value
    TextBox16.Value = Cells(x, "p").Value
    TextBox17.Value = Cells(x, "q").Value
    TextBox18.Value = Cells(x, "r").Value
    TextBox24.Value = Cells(x + 1, "d").Value
    TextBox25.Value = Cells(x + 1, "e").Value
    TextBox26.Value = Cells(x + 1, "f").Value
    TextBox27.Value = Cells(x + 1, "g").Value
    TextBox28.Value = Cells(x + 1, "h").Value
    TextBox29.Value = Cells(x + 1, "i").Value
    TextBox30.Value = Cells(x + 1, "j").Value
    TextBox31.Value = Cells(x + 1, "k").Value
    TextBox32.Value = Cells(x + 1, "l").Value
    TextBox33.Value = Cells(x + 1, "m").Value
    TextBox34.Value = Cells(x + 1, "n").Value
    TextBox35.Value = Cells(x + 1, "o").Value
    TextBox36.Value = Cells(x + 1, "p").Value
    TextBox37.Value = Cells(x + 1, "q").Value
    TextBox38.Value = Cells(x + 1, "r").Value
    TextBox19.Value = Cells(x, "ai").Value
    TextBox20.Value = Cells(x, "aj").Value
    TextBox21.Value = Cells(x, "ak").Value
    Exit For
    Else
   
        Dim cl As Control
        For Each cl In Me.Controls
            For i = 2 To 38
                If cl.Name = "TextBox" & i Then
                    cl = ""
                    i = i + 1
                End If
            Next i
        Next cl
    End If

Next x
End Sub

 

[235Waheed]

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

[حسونة حسين]

الحمد لله الذي بنعمته تتم الصالحات 

بالتوفيق ان شاء الله