Makroyla verilen kriterlere göre sütun ekleme

[lionamic]

MAKRO yardımıyla önce A sütunundaki her veriyi C,D sütünundaki kriterlere göre birbirinden ayırmak istiyorum.ayırma işlemi herbirinin arasına 1 boş satır ekleyerek olucak....daha sonra...oluşan her satır grubunda tutarların toplamının bu boş satırlara alınması ve tarih sütununun altınada kaç adet olduğunun yazılmasını istiyorum ve bunlar bold olarak yazılacak....2.sayfada olmasını istediğim şekli verdim...İlginizi için teşekürler.

 

[veyselemre]

[vb:1:e0b8a52190]Sub dene()
'arala
For x = [a65536].End(3).Row To 2 Step -1
If Cells(x, 2) <> Cells(x - 1, 2) Or Cells(x, 3) <> Cells(x - 1, 3) Or Cells(x, 4) <> Cells(x - 1, 4) Then Rows(x).Insert SHIFT:=xlDown
Next x
'toplamları yaz
bassat = 1
For x = 2 To [a65536].End(3).Row + 1
If Cells(x, 1) = "" Then
Cells(x, 6) = x - bassat
Cells(x, 7) = WorksheetFunction.Sum(Range(Cells(bassat, 7), Cells(x - 1, 7)))
Range(Cells(x, 6), Cells(x, 7)).Font.Bold = True
bassat = x + 1
End If
Next x
End Sub[/vb:1:e0b8a52190]

 

[hikmet]

sayın veyselemre; farkında olmadan benim sorumu da cevaplamış oldunuz ama mümkünse ilave bir şey sormak istiyorum bu işlemden sonra ara toplam oluşuyor, oluşan bu ara toplamları en alttaki boş satıra genel toplam olarak aldırabilirmiyiz.

 

[veyselemre]

sayın veyselemre; farkında olmadan benim sorumu da cevaplamış oldunuz ama mümkünse ilave bir şey sormak istiyorum bu işlemden sonra ara toplam oluşuyor, oluşan bu ara toplamları en alttaki boş satıra genel toplam olarak aldırabilirmiyiz.

[vb:1:b137389ab2]Sub hikmet()
'arala
For x = [a65536].End(3).Row To 2 Step -1
If Cells(x, 2) <> Cells(x - 1, 2) Or Cells(x, 3) <> Cells(x - 1, 3) Or Cells(x, 4) <> Cells(x - 1, 4) Then Rows(x).Insert SHIFT:=xlDown
Next x
'toplamları yaz
bassat = 1
For x = 2 To [a65536].End(3).Row + 1
If Cells(x, 1) = "" Then
say = say + x - bassat
Cells(x, 6) = x - bassat
topla = topla + WorksheetFunction.Sum(Range(Cells(bassat, 7), Cells(x - 1, 7)))
Cells(x, 7) = WorksheetFunction.Sum(Range(Cells(bassat, 7), Cells(x - 1, 7)))
Range(Cells(x, 6), Cells(x, 7)).Font.Bold = True
bassat = x + 1
End If
Next x

Cells(bassat, 5) = "G E N E L T O P L A M :"
Cells(bassat, 5).HorizontalAlignment = xlRight
Cells(bassat, 6) = say
Cells(bassat, 7) = topla
Range(Cells(bassat, 5), Cells(bassat, 7)).Font.Bold = True
End Sub[/vb:1:b137389ab2]

 

[hikmet]

sn.veyselemre emeğiniz için teşekkür ederim beni büyük bir dertten kurtardınız. :dua:

 

[AS3434]

Özür dilerim bilgisizliğimi bağışlayın.
Sn. Veyselemre yazmış olduğunuz kod her derde deva gibi bir şey .
Kodu sayfanın kod sayfasına yazdım ama sayfa 2 de sadece 2 satıra 1 ve 0 yazdı. Benmi çalıştırmayı beceremedim (büyük ihtimalle) . Makrolardan anlamadığım gibi nasıl çalıştırılacağı konusunda da bilgisizim.

 

[veyselemre]

Özür dilerim bilgisizliğimi bağışlayın.
Sn. Veyselemre yazmış olduğunuz kod her derde deva gibi bir şey .
Kodu sayfanın kod sayfasına yazdım ama sayfa 2 de sadece 2 satıra 1 ve 0 yazdı. Benmi çalıştırmayı beceremedim (büyük ihtimalle) . Makrolardan anlamadığım gibi nasıl çalıştırılacağı konusunda da bilgisizim.