Макрос чисел без повторений

Option Explicit
 
Const cntQueens = 5 'Êîëè÷åñòâî ëàäåé (èëè ðàçìåð äîñêè)
Dim H(1 To cntQueens) As Integer 'ãîðèçîíòàëü äëÿ êàæäîé ëàäüè
Dim chessMap As Range
Dim R As Long
 
Sub Queens()
'Erase H
Cells.Clear
Cells.Font.Size = 36
Cells.HorizontalAlignment = xlCenter
Cells.VerticalAlignment = xlCenter
Cells.RowHeight = 40
Cells.ColumnWidth = 6.86
Cells(1).Activate
R = 1
Ðåøåíèå 1
End Sub
 
Sub Ðåøåíèå(W As Integer)
Dim I As Integer
For H(W) = 1 To cntQueens
  For I = 1 To W - 1
    If H(I) = H(W) Then  'ëàäüè áüþò äðóã äðóãà
      Exit For 'èä¸ì ââåðõ, íà Next H(W)
    End If
  Next I
  If I = W Then 'ëàäüè íå áüþò äðóã äðóãà
    If W = cntQueens Then 'ëàäüÿ ïîñëåäíÿÿ
      Set chessMap = Range(Cells(R, 1), Cells(R + cntQueens - 1, cntQueens))
      With chessMap
        .Borders(xlEdgeLeft).LineStyle = xlContinuous
        .Borders(xlEdgeTop).LineStyle = xlContinuous
        .Borders(xlEdgeBottom).LineStyle = xlContinuous
        .Borders(xlEdgeRight).LineStyle = xlContinuous
      End With
      For I = 1 To cntQueens
'         Cells(cntQueens - H(I) + R, I) = ChrW(9819)
         Cells(cntQueens - H(I) + R, I) = ChrW(9814)
         Cells(R + cntQueens, I) = H(I)
      Next I
      R = R + cntQueens + 1
    Else 'ëàäüÿ íå ïîñëåäíÿÿ
      Ðåøåíèå W + 1 'èä¸ì ê ñëåäóþùåé
    End If
  End If
Next H(W)
End Sub

Dim R As Long
Dim C As Long
 
Sub Sm(S0 As String, s As String)
Dim i As Integer
  If Len(s) = 1 Then
    R = R + 1
    For C = 1 To Len(S0 + s)
     Cells(R, C) = Mid$(S0 + s, C, 1)
    Next C
    Exit Sub
  End If
  For i = 1 To Len(s)
    Sm S0 + Mid$(s, i, 1), Left$(s, i - 1) + Mid$(s, i + 1)
  Next
End Sub
 
Sub qqq()
R = 0
Sm "", "12345"
End Sub