Satır Ekle, Kopyala,Sırala,Alt Toplamlarını al.

[muratnazli]

Selamlar,

Çalıştığım bir dosya için geçmiş tarihlerdeki örnek kodları incelerken Hüseyin Bey'in daha önce yayımladığı aşağıdaki aralala maksosunu buldum. Ornek adlı doyada bu makro ile satırlar ekledikten sonra, eklenen satırlara başlığı kopyalayıp, her başlık altındaki verileri, önce kod başlığına göre sıralamak ve aynı başlığa göre alttoplam almak istiyorum yardımcı olursanız sevinirim.

Sub aralama()
Dim deger As Variant
Dim deger1 As Variant
baş:
deger = ActiveCell.Value
döngü:
ActiveCell.Offset(rowOffset:=1, columnOffset:=0).Activate
deger1 = ActiveCell.Value
If deger <> deger1 Then
ActiveCell.EntireRow.Insert
ActiveCell.Offset(rowOffset:=1, columnOffset:=0).Activate
GoTo baş
End If
değer = değer1
If deger1 = "" Then Exit Sub
GoTo döngü
End Sub

 

[Levent Menteşoğlu]

selam

yukarıda yamış olduğun makroya bazı ilaveler yaptım. ekte aşağıdaki makroya göre çalışmasını görebilirsin.

Sub aralama()
Range("A2:C10").Select
Selection.Sort Key1:=Range("A2"), Order1:=xlAscending, Header:=xlNo, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
Dim deger As Variant
Dim deger1 As Variant
baş:
deg = 0
deger = ActiveCell.Value
döngü:
ActiveCell.Offset(rowOffset:=1, columnOffset:=0).Activate
deger1 = ActiveCell.Value
satirno = ActiveCell.Row
deg = Cells(satirno - 1, 3).Value + deg
If deger <> deger1 Then
ActiveCell.EntireRow.Insert
Range("A1:C1").Copy
ActiveCell.PasteSpecial
Cells(satirno - 1, 4) = "TOPLAM:"
Cells(satirno - 1, 5) = deg
ActiveCell.Offset(rowOffset:=1, columnOffset:=0).Activate
GoTo baş
End If
değer = değer1
If deger1 = "" Then
Range(Cells(satirno - 2, 1), Cells(satirno - 2, 3)).Delete
GoTo 10
End If
GoTo döngü
10 End Sub

 

[hsayar]

Say&#305;n hocam
Verilerin s&#305;ral&#305; oldu&#287;u bir listemiz var
a5:g150 aral&#305;&#287;&#305;nda YER ALIYOR.
d s&#252;tununde Gruplar, F s&#252;tununda De&#287;erler yer almaktad&#305;r.

&#214;rnek G&#246;r&#252;n&#252;t&#252;s&#252; &#350;eklinde

A
A
A
A
A
A
B
B
B
B
B
C
C
C
C
C

ise her grubun Ba&#351;lang&#305;c&#305;na sat&#305;r eklemek, G s&#252;tununa Toplam&#305;n&#305; almak m&#252;mk&#252;nm&#252;d&#252;r?

kodlar&#305;n&#305;z uyarlayamad&#305;m.