khaldounabouisrae قام بنشر مارس 23 مشاركة قام بنشر مارس 23 لدس قائمة التلاميذ و اود البحث عموديا عن كل المعطيات كما في الكود الذي اخذته عن الاخ الرائع محمد هشام 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 رابط هذا التعليق شارك More sharing options...
أفضل إجابة محمد هشام. قام بنشر مارس 23 أفضل إجابة مشاركة قام بنشر مارس 23 وعليكم السلام ورحمة الله تعالى وبركاته 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 3 رابط هذا التعليق شارك More sharing options...
khaldounabouisrae قام بنشر مارس 23 الكاتب مشاركة قام بنشر مارس 23 الله يشدليك في الوالدة و الوالد اخي محمد هشام رابط هذا التعليق شارك More sharing options...
محمد هشام. قام بنشر مارس 23 مشاركة قام بنشر مارس 23 25 دقائق مضت, khaldounabouisrae said: الله يشدليك في الوالدة و الوالد اخي محمد هشام 😁😁😁 بارك الله في اخي سعد يسعدنا اننا استطعنا مساعدتك 1 رابط هذا التعليق شارك More sharing options...
الردود الموصى بها
Join the conversation
You can post now and register later. If you have an account, sign in now to post with your account.