Ba-bs raporu hazırlama

[halit3]

Kod:

Sub getir2()


sayf1 = "satis_noktasi_ciro 1 "
sayf2 = "rapor"


Worksheets(sayf2).Range(Worksheets(sayf2).Cells(4, "a"), Worksheets(sayf2).Cells(Rows.Count, "I")).ClearContents

son1 = Sheets(sayf1).Cells(Rows.Count, "a").End(3).Row
sat = 4

ReDim ara1(son1): ReDim ara2(son1):: ReDim ara3(son1):

For j = 2 To son1
ara1(j) = WorksheetFunction.Trim(Sheets(sayf1).Cells(j, "d"))
ara2(j) = WorksheetFunction.Trim(Sheets(sayf1).Cells(j, "e"))
ara3(j) = 1
Next j

For r = 2 To son1
aranan1 = ara1(r)
aranan2 = ara2(r)

[COLOR="Red"]say1 = 0
say2 = 0
say3 = 0
say4 = 0


sayd1 = 0[/COLOR]

For i = r To son1
If ara3(i) = 1 Then
bulunan1 = ara1(i)
bulunan2 = ara2(i)

If aranan1 = bulunan1 And aranan2 = bulunan2 Then

say1 = say1 + CDbl(Sheets(sayf1).Cells(i, "f").Value)
say2 = say2 + CDbl(Sheets(sayf1).Cells(i, "g").Value)
[COLOR="red"]say3 = say3 + CDbl(Sheets(sayf1).Cells(i, "h").Value)
say4 = say4 + CDbl(Sheets(sayf1).Cells(i, "ı").Value)[/COLOR]

ara3(i) = 0
[COLOR="red"]sayd1 = sayd1 + 1[/COLOR]
End If
End If

Next i

If [COLOR="red"]sayd1[/COLOR] > 0 Then

Sheets(sayf2).Cells(sat, "a").Value = Sheets(sayf1).Cells(r, "a").Value
Sheets(sayf2).Cells(sat, "b").Value = Sheets(sayf1).Cells(r, "b").Value
Sheets(sayf2).Cells(sat, "c").Value = Sheets(sayf1).Cells(r, "c").Value
Sheets(sayf2).Cells(sat, "d").Value = Sheets(sayf1).Cells(r, "d").Value
Sheets(sayf2).Cells(sat, "e").Value = Sheets(sayf1).Cells(r, "e").Value

Sheets(sayf2).Cells(sat, "f").Value = say1
Sheets(sayf2).Cells(sat, "g").Value = say2

[COLOR="red"]Sheets(sayf2).Cells(sat, "h").Value = say3
Sheets(sayf2).Cells(sat, "ı").Value = say4[/COLOR]

sat = sat + 1
End If

Next r
atla1:

MsgBox "İşleminiz tamamlanmıştır."

End Sub

 

[muratkul]

Çok sağolun Halit Hocam