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

[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]

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