عمل كشف تحليلي

[اشرف سعيد السويسي]

ارغب فى عمل بيان فى الورقة 2 يضم المصروفات العمومية طبقا للجدول الموجود

المصنف1.xlsx

[ابراهيم الحداد]

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

استخدم هذا الكود

Sub AnalysesData()
Dim ws As Worksheet, Sh As Worksheet
Dim LR As Long, i As Long, j As Long, p As Long
Dim Arr, Data As String
Set ws = Sheets("ورقة1")
Set Sh = Sheets("ورقة2")
Sh.Range("B5").Resize(100, 6).ClearContents
LR = ws.Range("D" & Rows.Count).End(xlUp).Row
Data = Sh.Range("B2")
Arr = ws.Range("B3:G" & LR).Value
ReDim Preserve Arr(1 To UBound(Arr, 1), 1 To UBound(Arr, 2))
For i = 1 To UBound(Arr, 1)
If Arr(i, 4) = Data Then
p = p + 1
For j = 1 To UBound(Arr, 2)
Arr(p, j) = Arr(i, j)
Next
End If
Next
If p > 0 Then Sh.Range("B5").Resize(p, UBound(Arr, 2)).Value = Arr


End Sub

 

[اشرف سعيد السويسي]

جزاك الله خيرا

[مهندس الاكسل]

من باب الاستنارة برأيك أستاذنا الكبير ابراهيم الحداد

هل ممكن استخدام هذا الكود؟ وم المحاذير من استخدامه؟ مع الشكر لتوضيحك، لأني مبتدأ في برمجة VBA للاكسل

 Sheets("ورقة1").Range("B2:G1414").AdvancedFilter Action:=xlFilterCopy, _
        CriteriaRange:=Range("E1:E2"), CopyToRange:=Range("B4:G4"), Unique:=False

 

طبعا الكود عبارة عن تسجيل ماكرو لعملية AdvancedFilter

والملف مرفق، 

 

وأكرر شكري أستاذي الكريم

المصنف1 (1).xlsm