اذهب الي المحتوي
أوفيسنا
بحث مخصص من جوجل فى أوفيسنا
Custom Search

الردود الموصى بها

  • أفضل إجابة
قام بنشر (معدل)

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

 

Dim f, WsData, MyRng(), Tbl()
Private Sub UserForm_Initialize()
  Set f = Sheets("Follow up")
 
  Set WsData = f.Range("A5:I" & f.[A650000].End(xlUp).Row)
  MyRng = WsData.Value
  
  For i = 1 To UBound(MyRng)
       n = n + 1: ReDim Preserve Tbl(1 To UBound(MyRng, 2), 1 To n)
         For k = 1 To UBound(MyRng, 2): Tbl(k, n) = MyRng(i, k): Next k
         
Me.ComboChoixColFiltre.List = Application.Transpose(WsData.Offset(-1).Resize(1))
   
   Me.ComboChoixColFiltre.ListIndex = 0
    
    Me.LabelColFiltre.Caption = "فلترة ب:" & Me.ComboChoixColFiltre
     
     ListBox1.ColumnWidths = "120;120;130;120;130;120;120;120"

Next i
     
' لإظهار  البيانات على الليست بوكس قم بتفعيل  السطر التالي
   
   'Me.ListBox1.Column = Tbl
   
End Sub
'**********************************************

Private Sub CommandButton1_Click()
Dim Tbl()
If Recherche.Value = Empty Or ComboChoixColFiltre.Value = Empty Then
MsgBox "المرجوا ادخال معيار البحث", vbInformation + vbMsgBoxRight + vbMagBoxRt1Reading, "تعليمات"
Exit Sub
End If
colRecherche = Me.ComboChoixColFiltre.ListIndex + 1
  clé = "*" & Me.Recherche & "*": n = 0
 
  For i = 1 To UBound(MyRng)
    If MyRng(i, colRecherche) Like clé Then
        n = n + 1: ReDim Preserve Tbl(1 To UBound(MyRng, 2), 1 To n)
        For k = 1 To UBound(MyRng, 2): Tbl(k, n) = MyRng(i, k): Next k
     End If
  Next i
  If n > 0 Then Me.ListBox1.Column = Tbl Else Me.ListBox1.Clear
End Sub

 

الإصدار أوفيسنا 2.xlsm

تم تعديل بواسطه محمد هشام.
  • Like 2

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