الصفتى

شكرا استاذ محمد لاهتمام حضرتك و جزاك الله خيرا

السلام عليكم لابد من بدء المشاركة بالتحية !!!يعمل هذا الكود بشكل جيد في البحث فى الليست بوكس ، ولكن عند تجربة سيناريوهين ، يحدث ما يلي: 1) عند استبدال سطر (myCols = Array (1، 3،4، 5، 7، 10) بى myCols = Array (TextBox 2) والسماح لـ TextBox 2 بالكتابة بالداخل إنه (1،3،4،5،7،10) يعطيني رسالة خطأ (application defined or object defined error يتم تمييزه في السطر التالي في الكود (a (ii 1 ، j) = ws.Cells ( i، myCols (ii)). value). ما هو الحل لهذا التحدي؟ 2) عند استبدال سطر (myCols = Array (1، 3،4، 5، 7، 10) بى myCols = Array (T1، T2،T3، T4، T5، T6) حيث T صناديق نص تحتوي على أرقام أعمدة منفصلة يعطى نتيجة صحيحة و لكن عند وجود تكست بوكس منهم فارغ فانه يعطينى رسالة خطا MISMATCH , و يعلم على السطر التالى بالكود code (a (ii 1، j) = ws.Cells (i، myCols (ii)). Value) ما هو الحل لهذا التحدي؟ listbox dynamic.xlsb

Dim rng1 As Range, str_search As String, row_number As Long, n As Long str_search = TextBox45.Value Set rng1 = ThisWorkbook.Sheets("data").Range("a:a").Find(str_search, , xlValues, xlWhole) If Not rng1 Is Nothing Then row_number = rng1.Row Application.ScreenUpdating = False For n = 46 To 321 Me.Controls("TextBox" & n).Value = ThisWorkbook.Sheets("data").Cells(row_number, n).Value Next n For n = 324 To 337 Me.Controls("TextBox" & n).Value = ThisWorkbook.Sheets("data").Cells(row_number, n).Value Next n Application.ScreenUpdating = True End If

السلام عليكم و رحمة الله كل عام و انتم بخير لدى هذا الكود لفلترة الليست بوكس باستخدام "checkbox" و باستخدام "combobox" و هو يعمل جيدا فى حالة ان يكون هناك اختيار فى "combobox" اما فى حالة عدم وجود اختيار فى"combobox" فانه لا يعمل فلترة ب"checkbox" فهل يمكن تعديله لكى يعمل فى كلتا الاحوال و شكرا جزيلا On Error Resume Next Dim aTB() As Variant, bTB As Variant Dim c As Integer, i As Integer c = 0 For i = 7 To 12 If Me("CheckBox" & i).Value = True Then ReDim Preserve aTB(c) aTB(c) = Me("CheckBox" & i).Caption c = c + 1 End If Next If Not Not aTB Then With ListBox2 For i = .ListCount - 1 To 0 Step -1 bTB = Filter(aTB, .List(i, 2), , vbTextCompare) If .List(i, 2) = "" Or UBound(bTB) < 0 Then .RemoveItem (i) Next End With End If If Len(Trim(Me.ComboBox2)) > 0 Then ReDim Preserve aTB(c) aTB(c) = Me.ComboBox2.Value c = c + 1 End If If Not Not aTB Then With ListBox2 For i = .ListCount - 1 To 0 Step -1 bTB = Filter(aTB, .List(i, 3), , vbTextCompare) If .List(i, 3) = "" Or UBound(bTB) < 0 Then .RemoveItem (i) Next End With End If test - Copy.xlsb

شكرا لقد افادنى احد الاساتذة بالحل باحد المنتديات و لا اعلم ان كان يحق لى نشرلينك الحل هنا ام لا

جزاكم الله خيرا و نفع بكم

شكر ا لكم اساتذتنا الكرام و لقد وجدت حل ثالث و هو Dim M As Long Dim Sum As Double Sum = 0 With Listfind For M = 0 To Listfind .ListCount - 1 If CDbl(Listfind .List(M,10)) > 0 Then Sum = Sum + Listfind .List(M,10) Next M End With UserForm1.TextBox6.Value = Sum

السادة الخبراء الافاضل ارغب فى كود لجمع الارقام الموجبة فقط فى عمود من قائمة listbox واظهار الناتج في خانة textbox

جزاك الله خيرا

UP

Dim x, ws As Worksheet, i As Long, j As Long, lastRow As Long With Me.ListBox1 .Clear .ColumnCount = 7 .ColumnWidths = "60 pt;150 pt;80 pt;150 pt;100 pt;70 pt;100 pt" .ColumnHeads = 0 Set ws = Sheets("Ledger") x = Application.Match(ComboBox1.Value, ws.Rows(1), 0) If Not IsError(x) Then lastRow = ws.Cells(Rows.Count, "B").End(xlUp).Row For i = 1 To lastRow If TextBox1 <> "" And InStr(ws.Cells(i, x), TextBox1) <> 0 Then .AddItem .List(j, 0) = ws.Cells(i, 1) .List(j, 1) = ws.Cells(i, 3) .List(j, 2) = ws.Cells(i, 4) .List(j, 3) = ws.Cells(i, 16) .List(j, 4) = ws.Cells(i, 17) .List(j, 5) = ws.Cells(i, 18) .List(j, 6) = ws.Cells(i, 10) j = j + 1 End If Next i End If End With المطلوب عند البحث باسخدام الكمبوبوكس و التكست بوكس يتم اظهار النتائج الموجوده فى شيت ليدجر فى النطاق من (a4:s ) و لكم جزيل الشكر test.xlsb

استاذى الفاضل هل ممكن تعديل الكود بحيث يظهر كل الاعمدة الموجوده فى الليدجر من a : s

Dim i As Integer Dim ListCount1 As Integer ListCount1 = ListBox1.ListCount - 1 If TextBox3.Value <> "" Or TextBox4.Value <> "" Or TextBox5.Value <> "" Or TextBox6.Value <> "" Or TextBox7.Value <> "" Then For i = ListCount1 To 0 Step -1 If InStr(1, ListBox1.List(i, 3), TextBox3) = 0 Then ListBox1.RemoveItem (i) If InStr(1, ListBox1.List(i, 3), TextBox4) = 0 Then ListBox1.RemoveItem (i) If InStr(1, ListBox1.List(i, 3), TextBox5) = 0 Then ListBox1.RemoveItem (i) If InStr(1, ListBox1.List(i, 3), TextBox6) = 0 Then ListBox1.RemoveItem (i) If InStr(1, ListBox1.List(i, 3), TextBox7) = 0 Then ListBox1.RemoveItem (i) Next i End If او مساعدتى فى تصحيح هذا الكود ان كان يفى بالمطلوب

السادة الخبراء الافاضل لقد وصلت لهذا الكود و لكنه لا يعمل بالشكل المطلوب هل ممكن المساعده فى تعديله ليؤدى الغرض Dim i As Integer Dim ListCount1 As Integer ListCount1 = ListBox1.ListCount - 1 If TextBox3.Value <> "" Or TextBox4.Value <> "" Or TextBox5.Value <> "" Or TextBox6.Value <> "" Or TextBox7.Value <> "" Then For i = ListCount1 To 0 Step -1 If InStr(1, ListBox1.List(i, 3), TextBox3) = 0 Or InStr(1, ListBox1.List(i, 3), TextBox4) = 0 Or InStr(1, ListBox1.List(i, 3), TextBox5) = 0 Or InStr(1, ListBox1.List(i, 3), TextBox6) Or InStr(1, ListBox1.List(i, 3), TextBox7) = 0 Then ListBox1.RemoveItem (i) End If Next i End If الملاحظات عليه : اذا اخترت اسم العميل من الكمبوبكس و كتبت حرف الف فى البحث ثم قمت باختيار اى تشيك بوكس و الضغط على على زر التصفية فقد لاحظت الاتى و لا اعرف السبب اولا : لا تعمل التصفية اذا اخترت اى تشيك بوكس الا اذا كان معه تشيك بوكس 4(علمية) فيتم التصفية مضبوط و لكن بدون اختيار تشيك بوكس4 معه فلا تعمل، ثانيا : اذا اخترت تشيك بوكس 4 فقط لوحده فانه يفلتر و لكن ياتى بجميع البيانات ما عدى ما يدل عليه تشيك بوكس 4(علمية) ثالثا : و ده مهم جدا انى ارغب فى ان التصفية تعمل باى اختيار منفرد او متعدد و اسف على الاطالة و لكم جزيل الشكر مرفق ملف معدل به الفورمتجربة (1).xlsb

تجربة (1).xlsb الساده الخبراء الافاضل برجاء المساعدة Dim i As Integer Dim ListCount1 As Integer ListCount1 = ListBox1.ListCount - 1 If TextBox3.Value <> "" Then For i = ListCount1 To 0 Step -1 If InStr(1, ListBox1.List(i, 3), TextBox3) = 0 Then ListBox1.RemoveItem (i) End If Next i End If كود التصفية يعمل على تصفية البيانات فى الليست بوكس وفقا للمكتوب فى تكست بوكس3 هل ممكن تعديل الكود وعمل كودين الاول ان يتم التصفية وفقا للمكتوب فى تكست بوكس 3 و تكست بوكس 4 معا الكود الثانى ان يتم تصفية البيانات بدون المكتوب فى تكست بوكس 3 و تكست بوكس 4 او ان امكن ان يكون التصفية بناء على checkbox3& checkbox2 & checkbox1