Private Sub CommandButton1_Click() yada burayı makro yapıp çalıştırın sub test() gibi.
Kod:
Sub getir(ByVal deger As String, ByVal alan As Integer, ByVal i As Integer)
Dim dic As Object, son As Long, say As Long, ii As Long, key As String
say = 0
Set dic = CreateObject("Scripting.Dictionary")
With ThisWorkbook.Worksheets("Özet Tablo")
son = Worksheets(.Cells(i, 1).Value).Range("A" & Rows.Count).End(3).Row
If son < 2 Then GoTo sonSub
For ii = 2 To son
If ThisWorkbook.Worksheets(.Cells(i, 1).Value).Range("H" & ii).Value = deger Then
key = ThisWorkbook.Worksheets(.Cells(i, 1).Value).Range("B" & ii).Value & deger
If Not dic.Exists(key) Then
dic.Add key, say
say = say + 1
End If
End If
Next
.Cells(i, alan).Value = say
End With
sonSub:
Set dic = Nothing
End Sub
Private Sub CommandButton1_Click()
Dim i As Long
With ThisWorkbook.Worksheets("Özet Tablo")
.Range("B2:D" & .Cells(Rows.Count, "A").End(3).Row + 1).ClearContents
For i = 2 To .Range("A" & Rows.Count).End(3).Row
getir "Bitti", 2, i
getir "Devam Ediyor", 3, i
getir "Ýptal", 4, i
Next
End With
End Sub