mahmoud nasr alhasany قام بنشر السبت at 13:44 قام بنشر السبت at 13:44 (معدل) السلام عليكم ورحمة الله وبركاتة رجاء مساعدتى جزاك الله خيرا يوجد خيارين بحث وكلاهما لايعمل بسبب انه لايتم عرض 12 عمود فى الليست بوكس ولاكن يتم عرض 10 اعمده فقط ListBox1.ColumnCount = 12.xlsm تم تعديل السبت at 13:45 بواسطه mahmoud nasr alhasany
محمد هشام. قام بنشر السبت at 17:07 قام بنشر السبت at 17:07 وعليكم السلام ورحمة الله تعالى وبركاته قبل الخوض في مسألة عرض الأعمدة أظن أنك بحاجة لمراجعة الشروط على الأكواد التالية For i = 2 To lastRow If (LCase(ws.Cells(i, 3).value) = LCase(searchValue1) Or searchValue1 = "ALL") And _ (LCase(ws.Cells(i, 4).value) = LCase(searchValue2) Or searchValue2 = "ALL") And _ ws.Cells(i, 3).value Like "*" & searchValue1 & "*" And _ (Not includeDates Or (ws.Cells(i, 2) >= DateMin And ws.Cells(i, 2) <= DateMax)) Then '================================================= ' For i = 2 To lastRow If Trim(ws.Cells(i, "b").value) = ComboBox5.value Then ComboBox4.value = ws.Cells(i, "a").value Exit For End If Next i أعتقد ان عناصر combobo4 و combobox 5 يتم تعبئتها بشكل خاطئ يرجى التأكد منها أولا أو تحديد الأعمدة المطلوبة دون الحاجة لإرفاق اي أكواد
mahmoud nasr alhasany قام بنشر السبت at 19:56 الكاتب قام بنشر السبت at 19:56 (معدل) اهلا وسهلا استاذنا / محمد هشام تقصد For i = 2 To lastRow If Trim(ws.Cells(i, "d").value) = ComboBox5.value Then ComboBox4.value = ws.Cells(i, "c").value Exit For End If Next i شكرا على الملاحظة ولاكن توجد مشكلة عرض الاعمدة وفقا لتاريخ والشروط لايتم لانها تعرض 10 اعمدة بدل من 12 لو وضعنا خاصية On Error Resume Next تم تعديل السبت at 20:28 بواسطه mahmoud nasr alhasany
محمد هشام. قام بنشر السبت at 20:38 قام بنشر السبت at 20:38 نعم مثلا كومبوبوكس 4 ,و5 يتم تعبئتها من الأعمدة 1,و2 وانت واضع شرط التحقق من قيم العمود D هل هو خطأ ؟ اظافة ان الطريقة المستخدمة في الملف لن تمكنك من عرض أكثر من 10 أعمدة لو وضحت ما تحاول فعله ممكن نعرض البيانات عادي على الليست بوكس وفلترتها بين تاريخين والشروط المطلوبة اذا حددت أعمدتها
mahmoud nasr alhasany قام بنشر الأحد at 07:59 الكاتب قام بنشر الأحد at 07:59 (معدل) هذا الملف بعد تعديله نأسف على الخطاء وهذا الكود لايقوم بعرض 12 عمود ولاكنه يعرض 10 فقط Private Sub CommandButton7_Click() Dim ws As Worksheet Dim lastRow As Long Dim searchValue1 As String Dim searchValue2 As String Dim currentRow As Long Dim DateMin As Date Dim DateMax As Date Dim includeDates As Boolean ' تحديد ورقة العمل Set ws = Worksheets("Sheet2") ' الحصول على القيم من عناصر التحكم searchValue1 = ComboBox4.value searchValue2 = ComboBox5.value If IsDate(TextBox9.value) Then DateMin = CDate(TextBox9.value) If IsDate(TextBox10.value) Then DateMax = CDate(TextBox10.value) includeDates = CheckBox1.value ' تحديد قيمة مربع الاختيار Dim userEndDate As Date ' التحقق من صحة التاريخ المدخل في TextBox2 If IsDate(TextBox10.value) Then userEndDate = CDate(TextBox10.value) If userEndDate > Date Then MsgBox "تاريخ النهاية لا يمكن أن يكون أكبر من تاريخ اليوم." Exit Sub End If End If ' تحديد الصف الأخير lastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row ' مسح قائمة النتائج وتحديد عرض الأعمدة With ListBox1 .Clear .ColumnCount = 12 .ColumnWidths = "35;50;45;50;65;40;35;40;45;40;45;40" .Font.Size = 6 End With currentRow = 0 For i = 2 To lastRow If (LCase(ws.Cells(i, 3).value) = LCase(searchValue1) Or searchValue1 = "ALL") And _ (LCase(ws.Cells(i, 4).value) = LCase(searchValue2) Or searchValue2 = "ALL") And _ ws.Cells(i, 3).value Like "*" & searchValue1 & "*" And _ (Not includeDates Or (ws.Cells(i, 2) >= DateMin And ws.Cells(i, 2) <= DateMax)) Then ' إضافة البيانات إلى القائمة ListBox1.AddItem ListBox1.List(currentRow, 0) = ws.Cells(i, 1).value ListBox1.List(currentRow, 1) = Format(ws.Cells(i, 2).value, "dd/mm/yyyy") ListBox1.List(currentRow, 2) = ws.Cells(i, 3).value ' ListBox1.List(currentRow, 3) = ws.Cells(i, 4).value ' ListBox1.List(currentRow, 4) = ws.Cells(i, 5).value ' ListBox1.List(currentRow, 5) = ws.Cells(i, 6).value ' ListBox1.List(currentRow, 6) = ws.Cells(i, 7).value ListBox1.List(currentRow, 7) = ws.Cells(i, 8).value ' ListBox1.List(currentRow, 8) = ws.Cells(i, 9).value ' ListBox1.List(currentRow, 9) = ws.Cells(i, 10).value ' ListBox1.List(currentRow, 10) = ws.Cells(i, 11).value ' ListBox1.List(currentRow, 11) = ws.Cells(i, 12).value currentRow = currentRow + 1 End If Next i If ListBox1.ListCount = 0 Then MsgBox "لم يتم العثور على نتائج" End If End Sub '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' ' كود اخر بحث Private Sub CommandButton6_Click() On Error Resume Next Dim ws As Worksheet Dim lastRow As Long Dim i As Long, j As Long Dim startDate As Date, endDate As Date ' تحديد ورقة العمل Set ws = ThisWorkbook.Sheets("Sheet2") ' تحديد النطاق الكامل للبيانات lastRow = ws.Cells(Rows.Count, "A").End(xlUp).Row ' تحويل التواريخ من نص إلى تنسيق التاريخ startDate = CDate(TextBox9.value) endDate = CDate(TextBox10.value) ' مسح البيانات السابقة من ListBox ListBox1.Clear ' تحديد عدد الأعمدة في ListBox ListBox1.ColumnCount = 12 ' ملء ListBox بالبيانات التي تطابق المعايير For i = 2 To lastRow If ws.Cells(i, "b").value >= startDate And ws.Cells(i, "b").value <= endDate And ws.Cells(i, "c").value = ComboBox4.value And _ ws.Cells(i, "d").value = ComboBox5.value Then ' قم بتغيير أرقام الأعمدة إذا لزم الأمر ListBox1.AddItem For j = 1 To 12 If Not IsEmpty(ws.Cells(i, j)) Then ListBox1.List(ListBox1.ListCount - 1, j - 1) = CStr(ws.Cells(i, j).value) ' تحويل القيمة إلى نص إذا لزم الأمر End If Next j End If Next i End Sub ListBox1.ColumnCount = 12.xlsm تم تعديل الأحد at 08:13 بواسطه mahmoud nasr alhasany
محمد هشام. قام بنشر الأحد at 11:53 قام بنشر الأحد at 11:53 جرب هدا Dim OnRng(), tbl, Irow, ColVisu(), Dates(), Choix() Private Sub UserForm_Initialize() tbl = "Table2" OnRng = Range(tbl).value For i = 1 To UBound(OnRng): OnRng(i, 2) = CDate(OnRng(i, 2)): Next i Irow = Range(tbl).Columns.Count ColVisu = Array(1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12) ListBox1.ColumnCount = 12 Set d = CreateObject("scripting.dictionary") d("*") = "" For i = LBound(OnRng) To UBound(OnRng) d(OnRng(i, 3)) = "" Next i Choix = d.keys '================' رقم السيارة ============== Tri Choix, LBound(Choix), UBound(Choix) Dim iTemp As Variant For i = LBound(Choix) To (UBound(Choix) - LBound(Choix)) \ 2 iTemp = Choix(i) Choix(i) = Choix(UBound(Choix) - i) Choix(UBound(Choix) - i) = iTemp Next i Me.ComboBox1.List = Choix '================' اسم السائق ======================== Set d = CreateObject("scripting.dictionary") d("*") = "" For i = LBound(OnRng) To UBound(OnRng) d(OnRng(i, 4)) = "" Next i Choix = d.keys Tri Choix, LBound(Choix), UBound(Choix) Me.ComboBox4.List = Choix Set d = CreateObject("scripting.dictionary") colDate = 2 For i = LBound(OnRng) To UBound(OnRng) d(OnRng(i, colDate)) = "" Next i Dates = d.keys Tri Dates, LBound(Dates), UBound(Dates) Me.ComboBox2.List = Dates: Me.ComboBox2 = Dates(0) Me.ComboBox3.List = Dates: Me.ComboBox3 = Dates(UBound(Dates)) Filtre End Sub Sub Filtre() Dim tbl() clé = Me.ComboBox1: If clé = "" Then clé = "*" cléLieu = Me.ComboBox4: If cléLieu = "" Then cléLieu = "*" début = CDate(Me.ComboBox2) fin = CDate(Me.ComboBox3) colDate = 2 n = 0 For i = LBound(OnRng) To UBound(OnRng) If OnRng(i, colDate) >= début And OnRng(i, colDate) <= fin And OnRng(i, 3) Like clé And OnRng(i, 4) Like cléLieu Then n = n + 1: ReDim Preserve tbl(1 To Irow, 1 To n) c = 0 For Each K In ColVisu c = c + 1: tbl(c, n) = OnRng(i, K) Next K End If Next i If n > 0 Then Me.ListBox1.Column = tbl Else Me.ListBox1.Clear MsgBox "لم يتم العثور على بيانات مطابقة", vbInformation, "نتائج التصفية" End If End Sub ListBox1.ColumnCount = 12-V2.xlsm 3
mahmoud nasr alhasany قام بنشر الإثنين at 09:19 الكاتب قام بنشر الإثنين at 09:19 (معدل) الف شكر استاذنا / محمد هشام على المجهود الرائع واضافة ترتيب البيانات على حسب الرغبة الف شكر لك هل يمكن عمل التقويم تاريخ بدل اظهارها رقميا كما يوجد فى الفورم من textbox9,10 بدل 2,3 combobox تم تعديل الإثنين at 11:55 بواسطه mahmoud nasr alhasany
أفضل إجابة محمد هشام. قام بنشر الإثنين at 13:58 أفضل إجابة قام بنشر الإثنين at 13:58 يمكنك دمج الطريقتين مع بعض كما في الصورة ListBox1.ColumnCount = 12-V3.xlsm 1 1
mahmoud nasr alhasany قام بنشر الإثنين at 19:30 الكاتب قام بنشر الإثنين at 19:30 (معدل) الف شكر استاذنا / محمد هشام على المجهود الرائع تسلم ايدك احسنت والله تم تعديل الإثنين at 19:30 بواسطه mahmoud nasr alhasany
الردود الموصى بها
Join the conversation
You can post now and register later. If you have an account, sign in now to post with your account.