اذهب الي المحتوي
أوفيسنا

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


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

 

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

Join the conversation

You can post now and register later. If you have an account, sign in now to post with your account.

زائر
اضف رد علي هذا الموضوع....

×   Pasted as rich text.   Paste as plain text instead

  Only 75 emoji are allowed.

×   Your link has been automatically embedded.   Display as a link instead

×   Your previous content has been restored.   Clear editor

×   You cannot paste images directly. Upload or insert images from URL.

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

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

Important Information