Перечисление всех различных слов, полученных перестановкой

Sub Combin2()
Dim A(10, 10), B(840)
For i = 1 To 7
A(i, 1) = "Ê": A(i, 2) = "Î": A(i, 3) = "Ë": A(i, 4) = "Î": A(i, 5) = "Ê": A(i, 6) = "Î": A(i, 7) = "Ë"
Next i
d = 1
For i = 1 To 7
For j = 1 To 7
For k = 1 To 7
For l = 1 To 7
For m = 1 To 7
For n = 1 To 7
For g = 1 To 7
 
If i = j Then GoTo 10
If i = k Then GoTo 10
If i = l Then GoTo 10
If i = m Then GoTo 10
If i = n Then GoTo 10
If i = g Then GoTo 10
If j = k Then GoTo 10
If j = l Then GoTo 10
If j = m Then GoTo 10
If j = n Then GoTo 10
If j = g Then GoTo 10
If k = l Then GoTo 10
If k = m Then GoTo 10
If k = n Then GoTo 10
If k = g Then GoTo 10
If l = m Then GoTo 10
If l = n Then GoTo 10
If l = g Then GoTo 10
If m = n Then GoTo 10
If m = g Then GoTo 10
If n = g Then GoTo 10
 
'Cells(d, 1) = A(g, i) + A(i, j) + A(j, k) + A(k, l) + A(l, m) + A(m, n) + A(n, i)
B(d) = A(i, j) + A(j, k) + A(k, l) + A(l, m) + A(m, n) + A(n, g) + A(g, i)
d = d + 1
10 '***
Next g, n, m, l, k, j, i
d = 1
For j = 1 To 840
For i = j To 839
If B(j) = B(i + 1) Then GoTo 20
GoTo 30
20 Cells(d, 2) = B(j)
d = d + 1
30 '***
Next i, j
End Sub

Sub Combin2()
Dim A(10, 10), B(720)
For i = 1 To 6
A(i, 1) = "К": A(i, 2) = "О": A(i, 3) = "Л": A(i, 4) = "Е": A(i, 5) = "С": A(i, 6) =
"О"
Next i
d = 1
For i = 1 To 6
For j = 1 To 6
For k = 1 To 6
For l = 1 To 6
For m = 1 To 6
For n = 1 To 6
If i = j Then GoTo 10
If i = k Then GoTo 10
If i = l Then GoTo 10
If i = m Then GoTo 10
If i = n Then GoTo 10
If j = k Then GoTo 10
If j = l Then GoTo 10
If j = m Then GoTo 10
If j = n Then GoTo 10
If k = l Then GoTo 10
If k = m Then GoTo 10
If k = n Then GoTo 10
If l = m Then GoTo 10
If l = n Then GoTo 10
If m = n Then GoTo 10
'Cells(d, 1) = A(i, j) + A(j, k) + A(k, l) + A(l, m) + A(m, n) + A(n, i)
B(d) = A(i, j) + A(j, k) + A(k, l) + A(l, m) + A(m, n) + A(n, i)
d = d + 1
10 '***
Next n, m, l, k, j, i
d = 1
For j = 1 To 720
For i = j To 719
If B(j) = B(i + 1) Then GoTo 20
GoTo 30
20 Cells(d, 2) = B(j)
d = d + 1
30 '***
Next i, j
End Sub

Option Explicit
Dim d
 
Sub Main()
    Dim v, k As Integer
    Set d = CreateObject("Scripting.dictionary")
    Ray "КОЛОКОЛ"
    For Each v In d.Keys
         k = k + 1: Cells(k, 2) = v
    Next
End Sub
 
Private Sub Ray(S As String, Optional SS As String = "")
    Dim i As Integer
    If Len(S) = 1 Then
        d.Item(SS & S) = d.Item(SS & S) + 1
    Else
       For i = 1 To Len(S)
          Ray Left$(S, i - 1) & Mid$(S, i + 1), SS & Mid$(S, i, 1)
       Next
    End If
End Sub