Aynı satırları sayıp sayfa2 ye toplamını yazma

[mustafa58]

Ekte ki dosyada bir örnek hazırladım. Dosyanın aslı 64.000 satır.
İstediğim A ve B sütünlarındaki verileri aynı olan satırların yanındaki sayıyı toplayıp
bunları sayfa2 ye yazması. İlginiz ve yardımlarınız için şimdiden teşekkürler.
Saygılarımla.

 

[Vedat Özer]

Selamlar,

Yanlış anlamışta olabilirim.

Sayfa2 'de c2 Hücresine ve aşagıya doğru çekin.

=TOPLA.ÇARPIM((Sayfa1!A$2:A$64000=$A2)*(Sayfa1!B$2:B$64000=$B2)*(Sayfa1!C$2:C$64000))

 

[hamitcan]

Aşağıdaki formülü Sayfa2'de D2 hücresine ekleyin ve çoğaltın. Dizi formülü olduğundan Ctrl+Shift+Enter'a basmayı unutmayın.

D2={=TOPLA(EĞER(Sayfa1!$A$2:$A$26=A2;EĞER(Sayfa1!$B$2:$B$26=B2;Sayfa1!$C$2:$C$26;0);0))}

 

[Ali]

Özet Tablo ile kolayca yapabilirsiniz.

 

[mustafa58]

Teşekkür.

Arkadaşlar her iki förmülüde deneyeceğim. Çok çok teşekkürler.

 

[mustafa58]

Eksiklik var

Her iki formülüde denedim. Olmadı benim istediğim sayfa2 nin otomatik dolması.
1. eksiklik sayfa1 C sütünlarını toplayıp sayfa2 deki C sütününa yazmıyor.
2. eksiklik sayfa1 deki mahalle ve sokak adlarını sayfa2 ye bir kez yazması.( yani mükerrer olmadan)
Umarım anlatabilmişimdir.
Saygılarımla.

 

[Ali]

Özet Tablo ile kolayca yapabilirsiniz.

????......

 

[mustafa58]

Özet tablo için yanıt

Ali arkadaşım önce özet tablo ile denedim. Beceremedim.
Sonra sitede mükerrer kayıtları aradım ama tam olarak sorunumu çözmedi.
Sonra dosya ekleyerek yardım istedim. İlgin için teşekkür ederim.

 

[İhsan Tank]

Ali arkadaşım önce özet tablo ile denedim. Beceremedim.
Sonra sitede mükerrer kayıtları aradım ama tam olarak sorunumu çözmedi.
Sonra dosya ekleyerek yardım istedim. İlgin için teşekkür ederim.

bu dosyayı bir denermisiniz

 

[Orion1]

Dosyanız ektedir.
Ne kadar sürede tamamlandığını yazarsanız memnun olurum.

Sub mukerer_59()
Dim sat As Long, z As Object, myarr(), list(), a As Long
Dim i As Long, deg As String, baslangic As Date, n As Long
sat = Sheets("Sayfa1").Cells(65536, "A").End(xlUp).Row
Application.ScreenUpdating = False
Sheets("Sayfa2").Range("A2:C65536").ClearContents
If sat < 2 Then Exit Sub
baslangic = Now
list = Sheets("Sayfa1").Range("A2:C" & sat).Value
Set z = CreateObject("Scripting.Dictionary")
ReDim myarr(1 To 3, 1 To sat)
For i = 1 To UBound(list, 1)
    deg = list(i, 1) & "-" & list(i, 2)
    If Not z.exists(deg) Then
        n = n + 1
        z.Add deg, n
        myarr(1, n) = list(i, 1)
        myarr(2, n) = list(i, 2)
    End If
    myarr(3, z.Item(deg)) = myarr(3, z.Item(deg)) + list(i, 3)
Next i
Set z = Nothing
Sheets("Sayfa2").Select
ReDim Preserve myarr(1 To 3, 1 To n)
Range("A2").Resize(n, 3) = Application.Transpose(myarr)
Erase myarr
Application.ScreenUpdating = True
MsgBox "Süre : " & Format(Now - baslangic, "hh:mm:ss") & vbLf & _
"İşlem Tamamlandı" & vbLf & "evrengizlen@hotmail.com", vbOKOnly + vbInformation
End Sub

 

[mustafa58]

Teşekkürler

Öncelikle site yöneticilerine ve bu siteyi kullanan arkadaşlara yardımın eden tüm arkadaşlara teşekkür ederim. Sorun çözüldü. Çözüm için Evren Gizlen arkadaşın kodlarını kullandım. Çünkü korkunç derecede hızlı. 65000 satırda işlem yaparken kronometre tutamadım. sanırım işlem 1 saniye civarında sonuçlanmış oluyor.
Evren arkadaşa da teşekkür ederim.
İyi ki varsınız.

 

[Orion1]

Öncelikle site yöneticilerine ve bu siteyi kullanan arkadaşlara yardımın eden tüm arkadaşlara teşekkür ederim. Sorun çözüldü. Çözüm için Evren Gizlen arkadaşın kodlarını kullandım. Çünkü korkunç derecede hızlı. 65000 satırda işlem yaparken kronometre tutamadım. sanırım işlem 1 saniye civarında sonuçlanmış oluyor.
Evren arkadaşa da teşekkür ederim.
İyi ki varsınız.

Rica ederim.
İyi çalışmalar.
Benim işim hız.
Ne yapayım hız yapmayı seviyorum.