Birbiri ile eşleşen metin değerlerinin bulunup toplanması

[sebastianmbl]

Arkadaşlar Merhaba,
Ekte size gönderdiğim excel dosyasında da göreceğiniz üzere,

A VE B sutünlarında yazılı olan metinlerden istenilen eşleşmeyi sağlayan
çiftlerin toplamının tek bir hücrede toplanması nasıl olur??


Teşekkürler

 

[Orion1]

dosyanız ektedir.

Option Base 1
Sub grup59()
Dim z As Object, liste(), myarr(), n As Long, i As Long, sat As Long
Dim deg As String
Range("C2:E" & Rows.Count).ClearContents
sat = Cells(Rows.Count, "A").End(xlUp).Row
liste = Range("A2:B" & sat).Value
sat = UBound(liste)
ReDim myarr(1 To 3, 1 To sat)
Set z = CreateObject("Scripting.dictionary")
For i = 1 To sat
    deg = liste(i, 1) & liste(i, 2)
    If Not z.exists(deg) Then
        n = n + 1
        z.Add deg, n
        myarr(1, n) = liste(i, 1)
        myarr(2, n) = liste(i, 2)
    End If
    myarr(3, z.Item(deg)) = myarr(3, z.Item(deg)) + 1
Next i
Application.ScreenUpdating = False
Erase liste
ReDim Preserve myarr(1 To 3, 1 To n)
Range("C2").Resize(n, 3) = Application.Transpose(myarr)
Application.ScreenUpdating = True
Erase myarr
Set z = Nothing
MsgBox "İşlem tamamlandı." & vbLf & "evrengizlen@hotmail.com"
End Sub

 

[tahsinanarat]

Orion1 hocam cevaplamış, bizim cevap biraz sönük kaldı.

Option Explicit
Altarnatif olsun, Sayfa2 de icmalini alır

Sub Ayni_Olanlar()

    Dim i   As Long, _
        j   As Long, _
        Deg As Variant, _
        s2  As Worksheet, _
        sk  As Worksheet, _
        a1, _
        a2, _
        d, _
        s
        
    Set s2 = Sheets("Sayfa1")
    Set sk = Sheets("Sayfa2")
    
    s2.Select
    j = sk.Cells(Rows.Count, "A").End(3).Row
    If j < 2 Then j = 2
    sk.Range("A2:D" & j).ClearContents
    j = 1
    Set d = CreateObject("Scripting.Dictionary")
    
    For i = 2 To Cells(Rows.Count, "A").End(3).Row
        Deg = Cells(i, "a") & "|" & Cells(i, "b")
        If Not d.exists(Deg) Then
            d.Add Deg, 1
        Else
            d.Item(Deg) = d.Item(Deg) + 1
        End If
    Next i
    
    a1 = d.keys
    a2 = d.items
    
    For i = 0 To d.Count - 1
        If a2(i) > 0 Then
            s = Split(a1(i), "|")
            j = j + 1
            sk.Cells(j, "A") = s(0)
            sk.Cells(j, "B") = s(1)
            sk.Cells(j, "C") = a2(i)
            
        End If
    Next i

    
End Sub

 

[sebastianmbl]

Merhaba,
İlginiz için teşekkürler,

Yalnız burada ki ana nokta;

Tüm eşleşmelerin listesi değil,

Örnekten yola çıkacak olursak M ve AMER Eşleşmesinin sadece sayısal
değerinin tek bir hücrede hesaplanmasıdır.

ve bunu fx formül yazarak tüm diğer excel dosyalarında farklı datalar ile kullanılabilmesidir.

 

[tahsinanarat]

O halde aşağıdaki formülü kendinize göre uyarlayarak istediğiniz hücrede deneyiniz.

=TOPLA(EĞER(A2:A14="M";EĞER(B2:B14="AMER";1)))

Dizi Formül,
İhsan bey çalışmalarından alıntıdır.

Alıntı:
*formül dizi formülüdür. ( dizi formülü formül yazıldıktan sonra enter tuşuna basmadan ctrl+shift+enter tuş kombinasyonu ile girilir )
*yada aktif hale getirilir
*eğer ki enter ile geçildiyse
*hücre üzerine gelinir
*f2 tuşuna basılır ve ctrl+shift+enter tuş kombinasyonu uygulanır
*formülün başında ve sonunda { }
*bu işaretçikler çıkar
*bunları el ile giriş yaptığınız takidrde formül hata verir
*kolay gelsin

 

[Orion1]

Merhaba,
İlginiz için teşekkürler,

Yalnız burada ki ana nokta;

Tüm eşleşmelerin listesi değil,

Örnekten yola çıkacak olursak M ve AMER Eşleşmesinin sadece sayısal
değerinin tek bir hücrede hesaplanmasıdır.

ve bunu fx formül yazarak tüm diğer excel dosyalarında farklı datalar ile kullanılabilmesidir.

Buyurun.
NOT: Dizi formül değildir.

=TOPLA.ÇARPIM(($A$2:$A$2000=F9)*($B$2:$B2000=G9))

 

[sebastianmbl]

Orion1 ve tahsinanarat,
İlginiz ve emeğiniz için teşekkür ediyorum.

Tam olarak iki cevap ta amaca ulaşmamızı sağlamıştır.