ممكن المساعدة في كود التصفية

[ابو محمد نصري]

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

BOOK1.xlsm

[محمد هشام.]

اذا  أخي الكريم المفروض أن يتم تصفية البيانات بشرط الإسم الموجود في textbox 

ويتم ترحيل النتائج إلى شيت معين ..المرجوا توضيح المطلوب دفعة واحدة تفاديا لاهدار الوقت وإعادة العمل على الملف 

 

[ابو محمد نصري]

ComboBox1 هو اسم العميل عند اختيار اسم يتم فلتره داخل الليست بوكس 

TEXTBOX1 هو اجمالي الذي يظهر في الليست بوكس

يتم ترحيل المعلومات من الليست بوكس الي صفحه التصفية..يتم البحث عن المعلومات من صفحه BT

[عبدالفتاح في بي اكسيل]

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

كما  انك  تطلب  3  اشياء  من  شانه  لا  احد  ينظر  الى  هكذا  مواضيع  .

بالاضافة  الى  ان  ملفك غير  واضح  تشرح  شيء  وداخل  الملف  شيء  اخر  والصورة مختلفة .

قبل  ان تطلب  المساعدة  نظم  ملفك جيدا   تطلب  البحث  بناء  على  الصورة  في  العمود G   وداخل  الملف  نفس  الاسماء  موجودة في  العمود  الاول، اذا  اي  عمود  يتم  على اساسه البحث ؟؟؟؟؟؟؟؟؟؟؟  كما  ان  رؤوس العناوين لاعمدة  اليست بوكس  غير  مطابقة للورقة  ، اما  اختيار  الانجليزية  او  العربية في  الشيت و الليست بوكس حتى  عندما  يتم جلب  البيانات  يستطيع  القاريء  فهم  هذه  البيانات عند  قراءتها   . 

[محمد هشام.]

السلام عليكم ورحمة الله تعالى وبركاته ..تفضل اخي

Dim H, BT(), Rng, Ncol, MH1(), MH2(), MH3
Private Sub UserForm_Initialize()
 Set H = Sheets("BT")
 Set Rng = H.Range("A6:H" & H.[A65000].End(xlUp).Row)
   MH2 = Array(2, 3, 4, 5, 6)
   MH1 = Array(2, 3, 6, 4, 5)
   MH3 = 1
   BT = Rng.Value
  Ncol = UBound(MH1) + 1
  Me.ListBox1.ColumnWidths = temp & ";150"
  For i = Ncol + 1 To 5: Me("textbox" & i).Visible = False: Next i
  Set d = CreateObject("scripting.dictionary")
  d("*") = ""
  For i = LBound(BT) To UBound(BT)
    d(BT(i, MH3)) = ""
    
  Next i
  
  temp = d.keys
  Me.ComboBox1.List = temp
  Me.ComboBox1 = "*"

End Sub
'''''''''''''''''''''''''''''''''''''''''''''''''''''
Private Sub B_résultat_Click()
  Set MH = Sheets("التصفية")
  MH.Range("B10:F100").ClearContents
  A = Me.ListBox1.List
  MH.[b10].Resize(UBound(A) + 1, UBound(A, 2) + 1) = A
  With ThisWorkbook.Worksheets("التصفية")
   Sheet4.Range("c3") = ComboBox1.Text
  .Range("c5").Value = CDate(Me.TextBox2.Value)
  .Range("c7").Value = CDate(Me.TextBox3.Value)
  End With
End Sub
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Private Sub ComboBox1_Change()
Sheet3.Range("P2") = ComboBox1.Text
TextBox1.Value = Sheets("BT").Range("Q2").Value
TextBox2.Value = Sheets("BT").Range("R2").Value
TextBox3.Value = Sheets("BT").Range("S2").Value

  Dim Tbl(): ReDim Tbl(1 To Ncol + 1, 1 To UBound(BT))
  ligne = 0
  For i = 1 To UBound(BT)
   If BT(i, MH3) Like Me.ComboBox1 Then
     ligne = ligne + 1
     c = 0
     For Each k In MH1
       c = c + 1: Tbl(c, ligne) = BT(i, k)
     Next k
    ' c = c + 1: Tbl(c, ligne) = i + Decal
    End If
   Next i
   ReDim Preserve Tbl(1 To Ncol + 1, 1 To ligne)
   Me.ListBox1.Column = Tbl

End Sub
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Sub TriS(A, gauc, droi)
  ref = A((gauc + droi) \ 2)
  g = gauc: d = droi
  Do
     Do While A(g) < ref: g = g + 1: Loop
     Do While ref < A(d): d = d - 1: Loop
     If g <= d Then
        temp = A(g): A(g) = A(d): A(d) = temp
        g = g + 1: d = d - 1
     End If
   Loop While g <= d
   If g < droi Then Call TriS(A, g, droi)
   If gauc < d Then Call TriS(A, gauc, d)
End Sub

Book_MH.xlsm

[ابو محمد نصري]

لو سمحت بنسبه لي التاريخ البحث في TEXTBO1 OR TEXTBOX2 ممكن التعديل علي 

الكود لا يلتزم في التاريخ الي التاريخ

[محمد هشام.]

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

Book_MH.xlsm

[ابو محمد نصري]

لو سمحت استاذ ممكن كمان ترحيل الي صفحه 

[محمد هشام.]

Book_MH_3.xlsm

[ابو محمد نصري]

جعلها الله في ميزان حسناتك استاذ Mohamed Hicham شكرا الكود رائع