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

[daryushm]

میخوام تو اکسلی که ضمیمه هست، اطلاعات شیت اول رو بگیره و شیت دوم رو بسازه!
ممنون میشم کمکم کنید...

[ATTACH]10014[/ATTACH]

[Ali Parsaei]

سلام،
حرف "ی" که در فايلتان استفاده کرده ايد در VBA مشکل ساز خواهد شد، براي همين من سعي کردم در کدنويسي ام از اون حرف استفاده نکنم و به خانه هاي خود فايل کد را ارجاع دهم، بنابراين شما اول در شيت گزارش خانه B1 عبارت: "حجم خريد" را به: "خريد" تغيير دهيد بعد مي توانيد از کد زير براي ستون مربوطه استفاده کنيد:

Sub Macro1()
Dim C As Range
Dim J As Integer
Dim I As Integer
J = 0
I = 2
Do While I < 100
For Each C In Sheets("transactions").Range("B2:B100")
If C.Value = Sheets("گزارش").Cells(I, 1).Value And C.Offset(0, 1).Value = Sheets("گزارش").Range("B1").Value Then
J = J + C.Offset(0, 2).Value
Sheets("گزارش").Cells(I, 1).Offset(0, 1).Value = J
End If
Next
J = 0
I = I + 1
Loop
End Sub 

براي فروش هم مي توانيد از همين کد الگو بگيريد و با تغيير آن به مقصود خود برسيد. البته کد فوق فقط جهت 100 رديف تنظيم شده

[iranweld]

با سلام

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

Sub TEST()

Dim N As Integer

Dim RNG, CEL As Range

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

K2 = Sheets("گزارش").Cells(Sheets("گزارش").Rows.Count, "B").End(xlUp).Row

Range("A2:A" & K2).ClearContents

N = 2

K = 2

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

For Each CEL In RNG

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

Sheets("گزارش").Range("A" & K).Value = CEL

K = K + 1

End If

N = N + 1

Next

End Sub 

[iranweld]

در فایل پیوست چنین مشکلی ندارد احتمالا کدها را داخل یک Module کپی نکردید

یا در ابتدای این سطر از ماکرو نام شیت گزارش را اضافه کنید

Range("A2:A" & K2).ClearContents 

sheets("گزارش").Range("A2:A" & K2).ClearContents 

[iranweld]

با سلام

در شیت اول برای ستون کالا ، خرید و فروش ، تعداد نام دینامیک تعریف گردید و در vb برای sumifs از آن استفاده گردید

WorksheetFunction.SumIfs([tedad], [kala], Sheet1.Range("a" & K), [kharid_forosh], Sheet1.Range("b1")) 

Sub TEST()

Dim N As Integer

Dim RNG, CEL As Range

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

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

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

N = 2

K = 2

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

For Each CEL In RNG

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

Sheet1.Range("A" & K).Value = CEL

Sheet1.Range("b" & K).Value = WorksheetFunction.SumIfs([tedad], [kala], Sheet1.Range("a" & K), [kharid_forosh], Sheet1.Range("b1"))

Sheet1.Range("c" & K).Value = WorksheetFunction.SumIfs([tedad], [kala], Sheet1.Range("a" & K), [kharid_forosh], Sheet1.Range("c1"))


K = K + 1

End If

N = N + 1

Next

End Sub 

[iranweld]

راهی هست که اگر اولین تراکنش مربوط به یک کالا "فروش" باشه یک پیغام در msgbox بده؟؟؟؟؟؟!!!!!!

در صورتیکه تاریخ ها در شیت مبدا به ترتیب باشد ، در شیت مقصد مورد خواسته شده ایجاد شد

If CEL.Offset(, 1).Value = "فروش" Then

Sheet1.Range("e" & K).Value = "اولین تراکنش فروش"

End If