[حل شده] لیست نمودن موارد تکراری و محاسبه هزینه های مربوط به آنها

[mobinsaffarpour]

باسلام خدمت دوستان عزیز

میخواستم بدونم چطور میتونم در شیت Rpt فایل پیوست، عملیات زیر رو از طریق کدنویسی انجام بدم :

1 - قراردادن کدهای ستون B شیت Table در ستون C شیت Rpt بصورت یکتا (Unique) و فقط آنهائی که وضعیت آنها اتمام است.

2 - محاسبه مجموع هزینه های انجام شده برای هر کد در ستون A شیت Rpt

3 - ایجاد شماره ردیف بصورت اتوماتیک مطابق با تعداد ردیف های ایجاد شده

4 - فرمت دهی ردیف های شماره 1 و 2 به تمامی ردیف های ایجاد شده ( سبز و سفید )

باتشکر از همه عزیزان

[iranweld]

با سلام

با استفاده از ماکرو ذیل چند پارامتر از خواسته شما تهیه گردید

با استفاده از دستور ذیل لیست یونیک ایجاد گردید

If WorksheetFunction.CountIf(Sheet2.Range(Sheet2.Cells(2, 2), Sheet2.Cells(N, 2)), Sheet2.Cells(N, 2)) = 1 Then 

با تعریف لیست دینامیک از شیت اصلی و با دستور sumifs موارد هزینه لیست یونیک ایجاد شده با هم جمع گردید

Sheet1.Range("a" & k).Value = WorksheetFunction.SumIfs([hazineh], [vaziat], ("ÇÊãÇã"), [cod], Sheet1.Range("c" & k).Value) 

Sub TEST()

Dim N As Integer

Dim RNG, CEL As Range

K1 = Sheet2.Cells(Sheet2.Rows.Count, "B").End(xlUp).Row

K2 = Sheet1.Cells(Sheet1.Rows.Count, "c").End(xlUp).Row

Sheet1.Range("c2:c" & K2).ClearContents

N = 2

k = 2

Set RNG = Sheet2.Range("B2:B" & K1)

Sheet1.Range("c1").Value = "˜Ï"

For Each CEL In RNG


If WorksheetFunction.CountIf(Sheet2.Range(Sheet2.Cells(2, 2), Sheet2.Cells(N, 2)), Sheet2.Cells(N, 2)) = 1 Then

If CEL.Offset(, -1).Value = "اتمام" Then

Sheet1.Range("c" & k).Value = CEL

Sheet1.Range("d" & k).Value = k - 1

Sheet1.Range("a" & k).Value = WorksheetFunction.SumIfs([hazineh], [vaziat], ("ÇÊãÇã"), [cod], Sheet1.Range("c" & k).Value)

k = k + 1

End If
End If

N = N + 1

Next

End Sub 

[mobinsaffarpour]

مرسی دوست عزیز اما دو مسئله

1 - چرا تمام مراکز هزینه ها رو که در وضعیت اتمام هستند رو در لیست قرار نمی ده - بعنوان نمونه 110101

2 - فرمت دهی رو چطور میشه انجام داده ( آیتم شماره 4 از پست 1 )

[iranweld]

در فایل جدید لیست یونیک ایجاد میگردد ولی اگر در ستون هزینه عددی صفر بود بدین معنی میباشد که هیچ آیتمی از آن در وضعیت اتمام نیست

[mobinsaffarpour]

دستت درد نکنه خیلی لطف کردی اما نمیشه مواردی که صفر هستند رو در Rpt نمایش نده و اینکه فرمت دهی رو چطور میشه انجام داده ( آیتم شماره 4 از پست 1 )

[iranweld]

دستت درد نکنه خیلی لطف کردی اما نمیشه مواردی که صفر هستند رو در Rpt نمایش نده و اینکه فرمت دهی رو چطور میشه انجام داده ( آیتم شماره 4 از پست 1 )

آیتم چهار هم با بررسی زوج بودن یا فرد بودن هر سطر و سپس رنگی نمودن سطرها فرد انجام شد با تغییر عدد 42 میتوانید طیف رنگ را تنظیم نمایید

If Sheet1.Range("c" & K).Row Mod 2 > 0 Then

Sheet1.Range("A" & K & ":D" & K).Interior.ColorIndex = 42

End If 

[mobinsaffarpour]

برادر عزیز دست شما درد نکنه عالی بود. اون مشکلاتی رو هم که داشت با ایجاد یک فایل جدید حل شد. متشکرم