اذهب الي المحتوي
أوفيسنا

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


إذهب إلى أفضل إجابة Solved by سليم حاصبيا,

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

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

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

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

رابط هذا التعليق
شارك

  • أفضل إجابة

الكود (اذا كانت البيانات كبيرة جداً 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

  • Like 1
  • Thanks 1
رابط هذا التعليق
شارك

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