اشرف سعيد السويسي قام بنشر يوليو 9, 2020 مشاركة قام بنشر يوليو 9, 2020 ارغب فى عمل بيان فى الورقة 2 يضم المصروفات العمومية طبقا للجدول الموجود المصنف1.xlsx رابط هذا التعليق شارك More sharing options...
أفضل إجابة ابراهيم الحداد قام بنشر يوليو 9, 2020 أفضل إجابة مشاركة قام بنشر يوليو 9, 2020 السلام عليكم ورحمة الله استخدم هذا الكود 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 5 رابط هذا التعليق شارك More sharing options...
اشرف سعيد السويسي قام بنشر يوليو 9, 2020 الكاتب مشاركة قام بنشر يوليو 9, 2020 جزاك الله خيرا رابط هذا التعليق شارك More sharing options...
مهندس الاكسل قام بنشر يوليو 11, 2020 مشاركة قام بنشر يوليو 11, 2020 من باب الاستنارة برأيك أستاذنا الكبير ابراهيم الحداد هل ممكن استخدام هذا الكود؟ وم المحاذير من استخدامه؟ مع الشكر لتوضيحك، لأني مبتدأ في برمجة VBA للاكسل Sheets("ورقة1").Range("B2:G1414").AdvancedFilter Action:=xlFilterCopy, _ CriteriaRange:=Range("E1:E2"), CopyToRange:=Range("B4:G4"), Unique:=False طبعا الكود عبارة عن تسجيل ماكرو لعملية AdvancedFilter والملف مرفق، وأكرر شكري أستاذي الكريم المصنف1 (1).xlsm 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.