اريد كود لكشف حساب

[حسن البدوي0]

السلام عاليكم ارجو من حضراتكم التكرم علي في ايجاد هذا الكود

اريد عند كتابة اسم العميل في الخليه c3 والضغط علي بحث تظهر نتائج العميل كما موضح في الشيت الثالث النتائج ماخوزا من الشيت رقم 2 (مجمع حسابات العملاء) مع مراعات ان عدد البيانات في الشيت رقم 2 ممكن يتخطي ال100000 سطر نظرا لكشف حساب عميل طويل المدة

كشف حساب عملاء.xlsx

[سليم حاصبيا]

لا حاجة للكود في هذا الملف 

تكفي المعادلات 

Badawi.xlsx

[حسن البدوي0]

@سليم حاصبيا استاذي المعادلة تعمل علي 500 سطر فقط واريد علي ما يزيد عن 100 الف سطر 

 

[سليم حاصبيا]

الكود (اذا كانت البيانات كبيرة جداً 100000 ضف ربما يأحذ وقتاً ليس بالقليل)

Option Explicit
Sub AL_in_One()
  Dim A As Worksheet, R As Worksheet
  Dim Rg_To_Copy As Range, F_rg As Range
  Dim Max_ro%, Adr1%, Adr2%
  Dim Boldate As Boolean, BolF3 As Boolean
  Dim BolF4 As Boolean
  

 Set A = Sheets("ALL")
 Set R = Sheets("Repport")
 R.Range("A8").CurrentRegion.Clear

 Max_ro = A.Cells(Rows.Count, 1).End(3).Row
 Set F_rg = A.Range("B2").Resize(Max_ro).Find(R.Range("C3"), lookat:=1)
  If Not F_rg Is Nothing Then
    Adr1 = F_rg.Row: Adr2 = Adr1
        Do
              Boldate = IsDate(A.Range("A" & Adr2))
          
              BolF3 = Int(A.Range("A" & Adr2)) >= R.Range("F3")
              BolF4 = Int(A.Range("A" & Adr2)) <= R.Range("F4")
              If Boldate * BolF3 * BolF4 <> 0 Then
                If Rg_To_Copy Is Nothing Then
                  Set Rg_To_Copy = A.Range("A" & Adr2).Resize(, 5)
                Else
                  Set Rg_To_Copy = Union(Rg_To_Copy, A.Range("A" & Adr2).Resize(, 5))
                End If 'Rg_To_Copy
              End If 'Boolean
             Set F_rg = A.Range("B2").Resize(Max_ro).FindNext(F_rg)
             Adr2 = F_rg.Row
             If Adr2 = Adr1 Then Exit Do
        Loop
  End If 'F_rg Is Nothing
  If Not Rg_To_Copy Is Nothing Then
     Rg_To_Copy.Copy
     R.Range("A8").PasteSpecial
  End If
Application.CutCopyMode = False
R.Activate: Range("C3").Select
End Sub

الملف مرفق

Badawi_1.xlsm

[حسن البدوي0]

شكرا اخي علي هذا المجهود الرائع شكرا جزيلا لكم