alihgrvdad123 قام بنشر فبراير 14, 2022 مشاركة قام بنشر فبراير 14, 2022 السلام عليكم - حياكم الله عندي ملف يحتوي على بيانات المطلوب فرز وجمع كل شعبة وحسب الملف المرفق فرز وجمع.xlsx رابط هذا التعليق شارك More sharing options...
محمد حسن المحمد قام بنشر فبراير 14, 2022 مشاركة قام بنشر فبراير 14, 2022 السلام عليكم ورحمة الله وبركاته أرجو أن تكون النتيجة مقبولة باستخدام Pivot table فرز وجمع.xlsx 1 رابط هذا التعليق شارك More sharing options...
alihgrvdad123 قام بنشر فبراير 14, 2022 الكاتب مشاركة قام بنشر فبراير 14, 2022 ممكن كود رابط هذا التعليق شارك More sharing options...
أفضل إجابة محمد حسن المحمد قام بنشر فبراير 15, 2022 أفضل إجابة مشاركة قام بنشر فبراير 15, 2022 السلام عليكم أرجو أن يكون مناسباً Sub Sort_Sum() Application.ScreenUpdating = False Sheets("البيانات").Range("Data").Copy Sheets("فرز وجمع").Range("Sort_Sum[اسم الموظف]").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False Application.CutCopyMode = False ActiveWorkbook.Worksheets("فرز وجمع").ListObjects("Sort_Sum").Sort.SortFields.Clear ActiveWorkbook.Worksheets("فرز وجمع").ListObjects("Sort_Sum").Sort.SortFields.Add Key:=Range("Sort_Sum[الشعبة]"), SortOn:=xlSortOnValues, Order:= _ xlAscending, DataOption:=xlSortNormal ActiveWorkbook.Worksheets("فرز وجمع").ListObjects("Sort_Sum").Sort.SortFields.Add Key:=Range("Sort_Sum[المبلغ]"), SortOn:=xlSortOnValues, Order:= _ xlAscending, DataOption:=xlSortNormal ActiveWorkbook.Worksheets("فرز وجمع").ListObjects("Sort_Sum").Sort.SortFields.Add Key:=Range("Sort_Sum[اسم الموظف]"), SortOn:=xlSortOnValues, Order:= _ xlAscending, DataOption:=xlSortNormal With ActiveWorkbook.Worksheets("فرز وجمع").ListObjects("Sort_Sum").Sort .Header = xlYes .MatchCase = False .Orientation = xlTopToBottom .SortMethod = xlPinYin .Apply End With Range("K2").FormulaR1C1 = _ "=SUMIF(Sort_Sum[[الشعبة]:[المبلغ]],[@الشعبة],Sort_Sum[المبلغ])" Range("K2").AutoFill Destination:=Range("شعب[المبلغ]") Range("a1").Select Calculate Application.ScreenUpdating = True End Sub فرز وجمع.xlsm 5 رابط هذا التعليق شارك More sharing options...
alihgrvdad123 قام بنشر فبراير 15, 2022 الكاتب مشاركة قام بنشر فبراير 15, 2022 جزيت خيرا تسلم هو المطلوب 2 رابط هذا التعليق شارك More sharing options...
lionheart قام بنشر فبراير 15, 2022 مشاركة قام بنشر فبراير 15, 2022 Sub Test() Const sOutput As String = "Output" Dim shp As Shape, m As Long, r As Long, n As Long Application.ScreenUpdating = False Application.DisplayAlerts = False On Error Resume Next: Sheets(sOutput).Delete: On Error GoTo 0 Application.DisplayAlerts = True Sheets(1).Copy , Sheets(Sheets.Count) Sheets(Sheets.Count).Name = sOutput With Sheets(sOutput) For Each shp In .Shapes shp.Delete Next shp .AutoFilterMode = False If .FilterMode = True Then .ShowAllData m = .Cells(Rows.Count, 1).End(xlUp).Row .Range("A1:H" & m).Sort Key1:=.Range("G1:G" & m), Order1:=xlAscending, Header:=xlYes r = 2 Do Until .Cells(r, 7).Value = Empty If r = 2 Then n = r If .Cells(r, 7).Value <> .Cells(r + 1, 7).Value Then .Rows(r + 1).Insert Shift:=xlDown .Cells(r + 1, 7).Value = "Total" .Cells(r + 1, 8).Formula = "=SUM(H" & n & ":H" & r & ")" With .Cells(r + 1, 7).Resize(, 2) .Font.Color = vbWhite .Interior.Color = RGB(55, 86, 36) End With r = r + 1 n = r + 1 End If r = r + 1 Loop End With Application.ScreenUpdating = True End Sub 2 1 رابط هذا التعليق شارك More sharing options...
محمد حسن المحمد قام بنشر فبراير 15, 2022 مشاركة قام بنشر فبراير 15, 2022 السلام عليكم ورحمة الله وبركاته أخي الكريم @lionheart جزاكم الله خيراً ..أحسنتم كود رائع لاستخلاص النتائج بواسطة كود Pivot Table تقبل تحياتي العطرة لشخصكم الكريم والسلام عليكم. 2 رابط هذا التعليق شارك 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.