düşeyara hakkında 1 soru ve adet birleştirme

[ytmercan]

2 ekteki soruma da yanıt alabilirsem çok sevineceğim.şimdiden çok teşekkürler

 

[Necdet]

Merhaba,

Adetleri tek satıra indirmeye katkım olsun.
Aşağıdaki kodları deneyebilirsiniz.

Public Sub Tek()
Application.ScreenUpdating = False
For i = [A65536].End(3).Row To 3 Step -1
    If Cells(i, "A") = Cells(i - 1, "A") Then
        Cells(i - 1, "C") = Cells(i - 1, "C") + Cells(i, "C")
        Rows(i).Delete
    End If
Next i
MsgBox "İşlem Bitmiştir........"
End Sub

 

[zafer]

Merhaba

1.sorunuzun cevabı Topla.çarpım(sumproduct) ile ilgili

ekli dosyayı inceleyiniz.

 

[ytmercan]

Pekİ Dİyelİmkİ M20 İle M21 Lerİ Ayni HÜcreye Toplamak İstedİm?

 

[zafer]

Merhaba

İkisini aynı hücrede toplatınız
=TOPLA.ÇARPIM((MART!C5:C100="M20")*(MART!B5:B100))+TOPLA.ÇARPIM((MART!C5:C100="M21")*(MART!B5:B100))

 

[ytmercan]

TeŞekkÜrler

 

[Necdet]

Tekrar merhaba,

İlk merhaba'ya yorum almamışız ama

Makrosuz çözüm ekte, ÖZET TABLO (PİVOT TABLE) ile yapılmış örneği inceleyebilirsiniz.

 

[tahsinanarat]

Sn. Necdet Yeşertener, eğer mükerrer kayıtlar alt alta değilde; farklı satırlarda olursa, kodlarda ne gibi bir değişiklik olmalı. Teşekkürler

 

[Necdet]

Satırları Birleştirmek

Merhaba,

Sayın tahsinanarat, koda sıralama komutunu eklemek gerekirdi.

Sub Tek()
Application.ScreenUpdating = False
SonSatır = [A65536].End(3).Row
[B][COLOR=red]Range("A2:C" & SonSatır).Sort Key1:=[A2]
[/COLOR][/B]For i = SonSatır To 3 Step -1
    If Cells(i, "A") = Cells(i - 1, "A") Then
        Cells(i - 1, "C") = Cells(i - 1, "C") + Cells(i, "C")
        Rows(i).Delete
    End If
Next i
MsgBox "İşlem Bitmiştir........"
End Sub

 

[tahsinanarat]

Teşekkür ederim. sn. Necdet Yeşertener. Şimdi daha güzel oldu.

 

[ytmercan]

iki sutunlu toplamda

benim bi sorum daha olacak.diyelimki toplanacak sütunlar 2 tane yani veri alınan sütun bir adet toplanacak o zaman nasıl bir formil olmalı.örneği ekliyorum

 

[Necdet]

9. mesajdaki kodlarda

Cells(i - 1, "C") = Cells(i - 1, "C") + Cells(i, "C")

satırından sonra

Cells(i - 1, "D") = Cells(i - 1, "D") + Cells(i, "D")

Satırını da eklemek gerekir, eğer daha fazla varsa E, F, G diye eklenmelidir.

Yani Kod:

Sub Tek()
Application.ScreenUpdating = False
SonSatır = [A65536].End(3).Row
Range("A2:[B][COLOR=red]D[/COLOR][/B]" & SonSatır).Sort Key1:=[A2]
For i = SonSatır To 3 Step -1
If Cells(i, "A") = Cells(i - 1, "A") Then
Cells(i - 1, "C") = Cells(i - 1, "C") + Cells(i, "C")
[B][COLOR=red]Cells(i - 1, "D") = Cells(i - 1, "D") + Cells(i, "D")[/COLOR][/B]
Rows(i).Delete
End If
Next i
MsgBox "İşlem Bitmiştir........"
End Sub

 

[ytmercan]

TeŞekkÜrler