تعديل كود البحث في القائمة ليشمل كافة المعطيات

[khaldounabouisrae]

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

Private Sub TextBox1_Change()  'Sheet donnes
  Dim a As Variant, b As Variant, clé As String
  Dim i&, j&, k&, m&
  Dim WS As Worksheet:       Set WS = Worksheets("donnes")
  Dim F As Worksheet:        Set F = Worksheets("search")

If Me.TextBox1 = "" Then
F.Range("b6:c" & Rows.Count).ClearContents
Else
  On Error Resume Next
  a = WS.Range("E5", WS.Range("F" & Rows.Count).End(3)).Value
  ReDim b(1 To UBound(a, 1), 1 To UBound(a, 2))
  clé = "*" & F.Range("b3").Value & "*"
  For i = 1 To UBound(a, 1)
    For j = 1 To UBound(a, 2)
      If LCase(a(i, j)) Like clé Then
        k = k + 1
        For m = 1 To UBound(a, 2)
          b(k, m) = a(i, m)
        Next
        Exit For
      End If
    Next
  Next
  F.Range("B6:C" & Rows.Count).ClearContents
  F.Range("b6").Resize(k, UBound(b, 2)).Value = b
  End If
End Sub
Private Sub TextBox1_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
  If Not iGblInhibitTextBoxEvents Then
  TextBox1.Value = ""
  End If
End Sub

بحث VBA.xlsm

[محمد هشام.]

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

Private Sub TextBox1_Change()
  Dim a As Variant, b As Variant, Clé$, Rng As Range, i&, j&, k&, m&
  Dim WS As Worksheet:       Set WS = Worksheets("donnes")
  Dim desWS As Worksheet:        Set desWS = Worksheets("search")
  Clé = "*" & desWS.[B3].Value & "*"
  Set Rng = desWS.Range("A6:G" & Rows.Count)
  a = WS.Range("D5", WS.Range("J" & Rows.Count).End(3)).Value

If Me.TextBox1 = "" Then
Rng.ClearContents
Else
Application.ScreenUpdating = False
With desWS
  On Error Resume Next
  .AutoFilterMode = False
  ReDim b(1 To UBound(a, 1), 1 To UBound(a, 2))
          For i = 1 To UBound(a, 1)
            For j = 1 To UBound(a, 2)
            
            'Filter by Uppercase and lowercase letters
            If LCase(a(i, j)) Like Clé Or UCase(a(i, j)) Like Clé Then
              k = k + 1
               For m = 1 To UBound(a, 2)
                  b(k, m) = a(i, m)
                    Next
                  Exit For
              End If
           Next
        Next
       Rng.ClearContents: Range("A6").Resize(k, UBound(b, 2)).Value = b
        Range("d6:d" & Rows.Count).NumberFormat = "dd-mm-yyyy"
     End With
   End If
  Application.ScreenUpdating = True
End Sub

 

بحث VBA V2.xlsm

[khaldounabouisrae]

الله  يشدليك في الوالدة  و الوالد اخي محمد هشام

[محمد هشام.]

25 دقائق مضت, khaldounabouisrae said:

الله  يشدليك في الوالدة  و الوالد اخي محمد هشام

😁😁😁 بارك الله في اخي سعد

  يسعدنا اننا استطعنا مساعدتك