Sub main()
    Const n As Long = 10, m As Long = 6
    Dim i As Long, a() As Long, tmr As Single
    ReDim a(1 To m) As Long
    
    tmr = Timer
    For i = 1 To m: a(i) = i: Next i
    Do
        Do
            CheckWords a(1) - 1, a(2) - 1, a(3) - 1, a(4) - 1, a(5) - 1, a(6) - 1
        Loop While NextPerm(a(), m)
    Loop While NextCombin(a(), n, m)
    Debug.Print Timer - tmr
End Sub

Sub CheckWords(n As Long, i As Long, t As Long, k As Long, a As Long, b As Long)
    If n = 0 Or t = 0 Then Exit Sub
    If n * 10000 + i * 1000 + t * 100 + k * 10 + a + _
       n * 10000 + i * 1000 + t * 100 + k * 10 + a = _
       t * 10000 + k * 1000 + a * 100 + n * 10 + b Then _
        Debug.Print n & i & t & k & a & " + " & n & i & t & k & a & " = " & t & k & a & n & b
End Sub

Function NextPerm(a() As Long, n As Long) As Boolean 'следующая перестановка в лексикографическом порядке
    Dim i As Long, k As Long, t As Long, tmp As Long
    For k = n - 1 To 1 Step -1
        If a(k) < a(k + 1) Then Exit For
    Next k
    If k Then
        For i = n To k + 1 Step -1
            If a(k) < a(i) Then tmp = a(k): a(k) = a(i): a(i) = tmp: Exit For
        Next i
        NextPerm = True
    End If
    t = n
    For i = k + 1 To (n + k) \ 2
        tmp = a(i): a(i) = a(t): a(t) = tmp
        t = t - 1
    Next i
End Function

Function NextCombin(a() As Long, n As Long, m As Long) As Boolean 'следующее сочетание
    Dim i As Long, j As Long
    For i = m To 1 Step -1
        If a(i) < n - m + i Then
            a(i) = a(i) + 1
            For j = i + 1 To m
                a(j) = a(j - 1) + 1
            Next j
            NextCombin = True
            Exit For
        End If
    Next i
End Function

Sub main()
    Const n As Long = 10, m As Long = 10
    Dim i As Long, a() As Long, tmr As Single
    ReDim a(1 To m) As Long
    
    tmr = Timer
    For i = 1 To m: a(i) = i: Next i
    'Do
        Do
            CheckWords a(1) - 1, a(2) - 1, a(3) - 1, a(4) - 1, a(5) - 1, a(6) - 1, a(7) - 1, a(8) - 1, a(9) - 1, a(10) - 1
        Loop While NextPerm(a(), m)
    'Loop While NextCombin(a(), n, m)
    Debug.Print Timer - tmr
End Sub

Sub CheckWords(o As Long, t As Long, v As Long, e As Long, c As Long, n As Long, b As Long, p As Long, r As Long, s As Long)
    If o = 0 Or p = 0 Then Exit Sub
    If o * 10000 + t * 1000 + v * 100 + e * 10 + t + _
       o * 10000 + c * 1000 + e * 100 + n * 10 + b = _
       p * 10000 + r * 1000 + o * 100 + s * 10 + t Then _
        Debug.Print o & t & v & e & t & " + " & o & c & e & n & b & " = " & p & r & o & s & t
End Sub

Function NextPerm(a() As Long, n As Long) As Boolean 'следующая перестановка в лексикографическом порядке
    Dim i As Long, k As Long, t As Long, tmp As Long
    For k = n - 1 To 1 Step -1
        If a(k) < a(k + 1) Then Exit For
    Next k
    If k Then
        For i = n To k + 1 Step -1
            If a(k) < a(i) Then tmp = a(k): a(k) = a(i): a(i) = tmp: Exit For
        Next i
        NextPerm = True
    End If
    t = n
    For i = k + 1 To (n + k) \ 2
        tmp = a(i): a(i) = a(t): a(t) = tmp
        t = t - 1
    Next i
End Function

Sub main()
    Const n As Long = 10, m As Long = 5
    Dim i As Long, a() As Long, tmr As Single
    ReDim a(1 To m) As Long
    
    tmr = Timer
    For i = 1 To m: a(i) = i: Next i
    Do
        Do
            CheckWords a(1) - 1, a(2) - 1, a(3) - 1, a(4) - 1, a(5) - 1
        Loop While NextPerm(a(), m)
    Loop While NextCombin(a(), n, m)
    Debug.Print Timer - tmr
End Sub

Sub CheckWords(u As Long, d As Long, a As Long, r As Long, k As Long)
    If u = 0 Or d = 0 Then Exit Sub
    If (u * 1000 + d * 100 + a * 10 + r) * 2 = _
       d * 10000 + r * 1000 + a * 100 + k * 10 + a Then _
        Debug.Print u & d & a & r & " + " & u & d & a & r & " = " & d & r & a & k & a
End Sub

Function NextPerm(a() As Long, n As Long) As Boolean  'следующая перестановка в лексикографическом порядке
    Dim i As Long, k As Long, t As Long, tmp As Long
    For k = n - 1 To 1 Step -1
        If a(k) < a(k + 1) Then Exit For
    Next k
    If k Then
        For i = n To k + 1 Step -1
            If a(k) < a(i) Then tmp = a(k): a(k) = a(i): a(i) = tmp: Exit For
        Next i
        NextPerm = True
    End If
    t = n
    For i = k + 1 To (n + k) \ 2
        tmp = a(i): a(i) = a(t): a(t) = tmp
        t = t - 1
    Next i
End Function

Function NextCombin(a() As Long, n As Long, m As Long) As Boolean 'следующее сочетание
    Dim i As Long, j As Long
    For i = m To 1 Step -1
        If a(i) < n - m + i Then
            a(i) = a(i) + 1
            For j = i + 1 To m
                a(j) = a(j - 1) + 1
            Next j
            NextCombin = True
            Exit For
        End If
    Next i
End Function