بحث في جميع اوراق العمل على اكثر من معيار

[mahmoud nasr alhasany]

مساء الخير

أنا أعمل على نموذج المستخدم. إنها عملية بحث تعتمد على عدة معايير. هناك مربعي نص (التاريخ) وصندوقي قائمة (العميل - رمز المنتج)، ولكن هذا يعتمد على البحث عن أوراق عمل متعددة واسترجاعها من مربع القائمة. هل يوجد كود بحث مثل هذا؟

يرجى عرض جميع علامات الاختيار في الأعمدة الصفراء لمربع القائمة بناءً على خيارات مربع التحرير والسرد ومربع النص (التاريخ)

البحث فى كل اوراق العمل1.xlsb

[mahmoud nasr alhasany]

On Error Resume Next
If TextBox8.Value = "" Then ListBox1.Clear: Exit Sub

Dim X As Worksheet
Dim c As Range
Dim k As Integer
Dim m As Date
Dim n As Date

ListBox1.Clear
k = 0

m = CDate(TextBox9.Value)
n = CDate(TextBox10.Value)

For Each X In ThisWorkbook.Worksheets
ss = X.Cells(Rows.Count, 2).End(xlUp).Row
For Each c In X.Range("B2:B" & ss)
If (c.Value Like "*" & ComboBox1.Value & "*" Or c.Value Like "*" & ComboBox2.Value & "*") And (c.Offset(0, 2).Value >= m And c.Offset(0, 2).Value <= n) Then
ListBox1.AddItem
ListBox1.List(k, 0) = X.Cells(c.Row, 1).Value
ListBox1.List(k, 1) = CDate(X.Cells(c.Row, 2).Value)
ListBox1.List(k, 2) = X.Cells(c.Row, 3).Value
ListBox1.List(k, 3) = X.Cells(c.Row, 4).Value
ListBox1.List(k, 4) = X.Cells(c.Row, 5).Value
ListBox1.List(k, 5) = X.Cells(c.Row, 6).Value
ListBox1.List(k, 6) = X.Cells(c.Row, 7).Value
ListBox1.List(k, 7) = X.Cells(c.Row, 8).Value
ListBox1.List(k, 8) = X.Cells(c.Row, 9).Value
ListBox1.List(k, 9) = X.Cells(c.Row, 10).Value
k = k + 1
End If
Next c
Next X

 

[محمد هشام.]

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

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

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

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

تم تعديل سبتمبر 24, 2023 بواسطه محمد هشام.

[حسونة حسين]

اخي mahmoud_nasr

يرجي تعديل اسمك باسم مناسب

وليس كما هو موجود بالاسم @عمل قائمة منسدلة مفلترة تقرأ من

[mahmoud nasr alhasany]

On Error Resume Next
Dim X As Worksheet
Dim k As Integer
Dim m As Date
Dim n As Date

ListBox1.Clear
rng1 = CDate(TextBox9.Value)
rng2 = CDate(TextBox10.Value)
rng3 = ComboBox1.Text
rng4 = ComboBox2.Text
dfr = 0
For Each X In ThisWorkbook.Worksheets
    ss = X.Cells(Rows.Count, 2).End(xlUp).Row
 For i = 2 To ss
If X.Cells(i, 6) Like "*" & rng3 & "*" And X.Cells(i, 4) Like "*" & rng4 & "*" And X.Cells(i, 2) >= rng1 And X.Cells(i, 2) <= rng2 Then
ListBox1.AddItem
ListBox1.List(dfr, 0) = X.Cells(i, 1)
ListBox1.List(dfr, 1) = Format(X.Cells(i, 2), "dd/mm/yyyy")
ListBox1.List(dfr, 2) = X.Cells(i, 3)
ListBox1.List(dfr, 3) = X.Cells(i, 4)
ListBox1.List(dfr, 4) = X.Cells(i, 5)
ListBox1.List(dfr, 5) = X.Cells(i, 6)
ListBox1.List(dfr, 6) = X.Cells(i, 7)
ListBox1.List(dfr, 7) = X.Cells(i, 8)
ListBox1.List(dfr, 8) = X.Cells(i, 9)
ListBox1.List(dfr, 9) = X.Cells(i, 10)
ListBox1.List(dfr, 10) = X.Cells(i, 11) '.Value
ListBox1.List(dfr, 11) = X.Cells(i, 12) '.Value
dfr = dfr + 1
                End If
    Next i
Next X
Call Main
Call Sort

 

شكرا جزيلا  ا/ محمد هشام لقد تم الحل ونسيت ان ارفقه