satırlar üzerinde birden fazla tekrar eden değerler birkez nasıl sayılır

[dlukas]

ekde istenileni anlatmak istedim,yardım içim tşk.
ltf rar ile cevap vermeyin.excel 2003 kullanıyorum

 

[Orion1]

Dosyanız ektedir.

Option Base 1
Sub tekrarlar59()
Dim sh As Worksheet, sat As Long, liste(), i As Long, z As Object
Dim j  As Byte
Sheets("Sayfa1").Select
Range("L:M").ClearContents
Application.ScreenUpdating = False
sat = Cells(Rows.Count, "B").End(xlUp).Row
liste = Range("B3:J" & sat).Value
Set z = CreateObject("scripting.dictionary")
For i = 1 To UBound(liste)
    If UCase(Replace(Replace(liste(i, 9), "i", "İ"), "ı", "I")) = "RİSKLİ" Then
        For j = 1 To 8
            If IsNumeric(liste(i, j)) Then
                If Not z.exists(liste(i, 9) & " " & liste(i, j)) Then
                    z.Add liste(i, 9) & " " & liste(i, j), 1
                    Else
                    z.Item(liste(i, 9) & " " & liste(i, j)) = z.Item(liste(i, 9) & " " & liste(i, j)) + 1
                End If
            End If
        Next j
    End If
Next i
Range("L3").Resize(z.Count, 2) = Application.Transpose(Array(z.keys, z.items))
Application.ScreenUpdating = True
MsgBox "İşlem Tamamdır." & vbLf & "evrengizlen@hotmail.com", _
    vbOKOnly + vbInformation, Application.UserName

        
End Sub

 

[dlukas]

TEŞEKKÜRLER Orion1
AMA BEN MAKRO OLARAK İSTEMİYORUM,
FÖRMÜL İLE NASIL YAPARIZ,EGERSAY FÖRMÜLÜ KOYMUŞSUN
AMA TÜM DEĞERLERİ SAYDIRMIŞSIN
BEN B VE I SATIRLARI ARASINDA EĞER 2 KEZ BİR DEĞER TEKRAR ETMİŞ İSE
BUNU BİR KEZ SAAYMASINI İSTEMİŞTİM.