Çözüldü Boşlukları Kaldırmak

Sub ExcelTurkey()
    Dim a&, kelime$
    With CreateObject("Scripting.Dictionary")
        For a = 2 To Cells(Rows.Count, "A").End(3).Row
            kelime = Trim(Cells(a, 2).Value)
            If Not .Exists(kelime) Then
                .Add kelime, 1
                    Else
                .Item(kelime) = .Item(kelime) + 1
            End If
        Next a
        Range("F2").Resize(.Count, 1).Value = Application.Transpose(.Keys)
        Range("G2").Resize(.Count, 1).Value = Application.Transpose(.Items)
    End With
    kelime = vbNullString: a = Empty
End Sub

Sub ExcelTurkey()
    Dim a&, kelime$
    With CreateObject("Scripting.Dictionary")
        For a = 2 To Cells(Rows.Count, "A").End(3).Row
            If Cells(a, 3).Value = "kadrolu" Then
                kelime = Trim(Cells(a, 2).Value)
                If Not .Exists(kelime) Then
                    .Add kelime, 1
                        Else
                    .Item(kelime) = .Item(kelime) + 1
                End If
            End If
        Next a
        Range("E2").Resize(.Count, 1).Value = "kadrolu"
        Range("F2").Resize(.Count, 1).Value = Application.Transpose(.Keys)
        Range("G2").Resize(.Count, 1).Value = Application.Transpose(.Items)
    End With
    kelime = vbNullString: a = Empty
End Sub