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

استخدام كود الفلترة المتقدمهAdvanced filter


إذهب إلى أفضل إجابة Solved by ياسر خليل أبو البراء,

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

أشاره الى موضوع الاستاذ ابو البراء بخصوص الفلتره المتقدمه

حاولت اطبق الفلتره المتقدمه التي شرحتها على ملف عندي فيه بيانات فواتير

وكنت اريد فلترة الفواتير برقم الملف وبنفس طريقه الملف الذي ارفقته ولكن لم تضبط معي

 

هل ممكن تطبيق الكود على ملفي

وتكون الفلترة بمتغير واحد وليس متغيرين كما في ملفك

 

الداتا موجوده في شيت (Invoices)

واريد الفلتره ان تكون في الشيت (Inv.History)

وشكرا

 

Book1.rar

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

أخي الكريم ماجد

إليك الحل التالي

Sub FilterDataAccordingToDates()
    Dim WS As Worksheet, SH As Worksheet
    Dim Cell As Range, lRow As Long
    Set WS = Sheets("Invoices"): Set SH = Sheets("Inv.History")
    lRow = 5
    
    Application.ScreenUpdating = False
        SH.Range("A5:N1000").ClearContents
        For Each Cell In WS.Range("B2:B" & WS.Cells(Rows.Count, 2).End(xlUp).Row)
            If Cell.Value = SH.Range("C2").Value Then
                Cell.Offset(, -1).Resize(, 14).Copy
                SH.Cells(lRow, 1).PasteSpecial xlPasteValues
                lRow = lRow + 1
            End If
        Next Cell
        SH.Range("C2").Select
    Application.CutCopyMode = False
    Application.ScreenUpdating = True
End Sub

تقبل تحياتي

Invoices.rar

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

ياسلام عليك يا استاذ  ابو البراء ماشاء الله تبارك الله

 

الكود يعمل بشكل صحيح

ولاحضت عدم استخدامك للفلتره المتقدمه كما شرحت في موضوعك السابق

 

حاولت تشغيل الكود بدون زر التفعيل فنسخت الكود  في( Private Sub Worksheet_SelectionChange(ByVal Target As Range) اصبح ياخذ وقت طويل جدا حتى ينفذ الكود حيث انه يمر على 1000 سطر للبحث

هل من الممكن تلافي هذه المشكله لان عدد الفواتير قد يصل الى اكثر من 1000

 

مع الشكر على التفاعل

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

أخي الحبيب

لا أحبذ العمل في حدث ورقة العمل في حالة البيانات الكبيرة ..لأن في حالتك Worksheet_Selection Change مع كل تحديد للخلايا سيتم تنفيذ الكود وهو أمر مرهق

أعتقد أنه من الأفضل عمل زر وربط الماكرو به تيسيراً عليك

وإذا أردت تحديث البيانات فقط اضغط الزر

أما بالنسبة لعدم استخدامي للفلترة المتقدمة فهو من باب التنوع في الحلول ولأن الفلترة تقوم بعمل نطاقات مسماة وهو ما أستحبه شخصياً

 

أمر آخر يمكنك استخدام الاستدعاء للكود باستخدام Worksheet_Change أفضل بهذا الشكل

Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.Cells.CountLarge > 1 Then Exit Sub
    If Not Intersect(Target, Range("C2")) Is Nothing Then
        Call FilterDataAccordingToDates
    End If
End Sub

جرب الكود بهذا الشكل وأعلمنا بالنتيجة

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

  • أفضل إجابة

أخي الحبيب ماجد

بما أن البيانات لديك كثيرة فإليك هذا الحل السحري باستخدام المصفوفات

Sub CopyDataUsingArrays()
    Dim A, I As Long, II As Long, N As Long, myDate
    With Sheets("Inv.History")
        myDate = .[C2].Value
        With .[A4].CurrentRegion.Offset(1)
            .ClearContents
            A = Sheets("Invoices").Cells(1).CurrentRegion.Value
            For I = 2 To UBound(A, 1)
                If A(I, 2) = myDate Then
                    N = N + 1
                    For II = 1 To UBound(A, 2)
                        A(N, II) = A(I, II)
                    Next
                End If
            Next
            If N > 0 Then .Resize(N).Value = A
        End With
    End With
End Sub

جرب الكود وأعلمنا بالنتيجة ..جرب الكود على الملف الأصلي

تقبل تحياتي

Invoices V2.rar

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

الأخ الكريم ماجد

يرجى تحديد أفضل إجابة ..

المشاركة رقم 5 أقوى 100 مرة حيث التعامل مع المصفوفات يتيح لك التعامل مع البيانات الكثيرة جداً ..دفعني إلى ذلك ذكرك أن البيانات تتعدى الـ 1000 ..يمكنك التأكد بزيادة البيانات إلى50000 مثلاً وشوف النتائج

عموماً الحمد لله أن تم المطلوب على خير

لا تنسى التوجيهات

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

زائر
هذا الموضوع مغلق.
  • تصفح هذا الموضوع مؤخراً   0 اعضاء متواجدين الان

    • لايوجد اعضاء مسجلون يتصفحون هذه الصفحه
×
×
  • اضف...

Important Information