我想实现几个数字的排列,但是不会,请指点

Question

比如有四个数字4,3,2,1我想用vb把这四个数所组成的四位数全部排出来,但是不会,上qq发问,有朋友说用递归,递归基本懂,但是从网上找到了如下代码:Option Explicit '本程序用来测试全排列的递归输出情况
Option Base 1 '设置数组的默认下标为1
Dim s() As String '字符串全排列存储函数
Dim Index% '字符串数组的索引Private Sub Form_DblClick()
    Dim t$
    t = CStr(InputBox(""))
    ReDim s(GetFactorial(Len(t))) '数组必须至少有n!个元素
    Index = 1
    Perm t, 1, Len(t)
    Dim i%
    For i = LBound(s) To UBound(s)
        Print s(i)
    Next i
End SubPrivate Sub Form_Click()
    Form1.Cls
End SubPrivate Sub Form_Load()
    Form1.AutoRedraw = True '设置窗体的自动重画属性为真
End SubPrivate Function Perm(ByVal St$, ByVal i%, ByVal j%) As String '字符串的全排列输出函数
    If i = j Then
        s(Index) = St
        Index = Index + 1
    Else
        Dim t%, S1$, S2$
        For t = i To j
            S1 = Mid(St, t, 1): S2 = Mid(St, i, 1)
            Mid(St, t, 1) = S2: Mid(St, i, 1) = S1 '交换目标字符串的两个字符
            Perm St, i + 1, j
            S1 = Mid(St, t, 1): S2 = Mid(St, i, 1)
            Mid(St, t, 1) = S2: Mid(St, i, 1) = S1
        Next t
    End If
End FunctionPrivate Function GetFactorial(ByVal X&) As Double '求阶乘函数
    Dim t#: GetFactorial = 1
    For t = 1 To X
        GetFactorial = GetFactorial * t
    Next t
End Function
还是看不懂,请高手们指点,最好留下qq好吗?

Answer 1

说实话没怎么明白你的意思  方便的话把程序和要求写清楚发我邮箱  我帮你看一下[email protected]

Answer 2

for i=1000 to 9999
   判断
next

Answer 3

最简单的最清楚最没技巧的就是
Private Sub Command2_Click()
  For i = 1 To 4
    For j = 1 To 4
      If j <> i Then
        For k = 1 To 4
          If k <> j And k <> i Then
            For m = 1 To 4
              If k <> i And k <> j And k <> m Then
                DoEvents
                Debug.Print CStr(i) + CStr(j) + CStr(k) + CStr(m)
              End If
            Next m
          End If
       Next k
    End If
  Next j
Next i

Answer 4

不用递归，一个效率不是很好的进位算法，也就是原于vansof的for i=1000 to 9999这样的思维：'进位算法
Sub Carry(aIdx() As Long, ByVal M As Long, ByVal N As Long)
    'aIdx是要排列数组的index数组
    'M是要排列数组的最大下标
    'N是aIdx的最大下标
    
    Dim idx As Long
    Dim i As Long
    Dim b() As Boolean
    Dim t As Long    idx = N
    Do While t = 0
        '最后一位加1
        aIdx(idx) = aIdx(idx) + 1
        '如果加1后，aIdx(idx)小于要排列数组的最大下标
        If aIdx(idx) <= M Then
            t = 1
            '测试有没有重复的idx
            ReDim b(M)
            For i = 1 To N
                b(aIdx(i)) = Not b(aIdx(i))
                '如果有重复的idx
                If b(aIdx(i)) = False Then
                    t = 0
                    idx = N    'idx设置到最后一位(为重新加1)
                    Exit For
                End If
            Next
        Else '如果加1后，aIdx(idx)大于要排列数组的最大下标
            aIdx(idx) = 1      '当前值设置为最小
            idx = idx - 1      'idx向前进一位
            '这里相当于算术进位
        End If
    Loop
            
End Sub'输出排列
Sub PrintComs(arr() As Variant, aIdx() As Long)
    Dim i As Long
    For i = 1 To UBound(aIdx)
        Debug.Print arr(aIdx(i) - 1);
    Next
    Debug.Print
End Sub'测试：
Private Sub Command1_Click()    Dim arr()
    Dim i As Long
    Dim M As Long, N As Long
    
    '定义一个要排列的数组
    'arr = Array("a", "b", "c", "d", "e", "f")
    arr = Array(1, 2, 3, 4)
    
    '得到M值（最大下标）
    M = UBound(arr) + 1
    '设置要排列的数
    N = 4
    If M < N Then
        MsgBox "Error: M < N"
        Exit Sub
    End If
    '以上相当于M个中用N个排列
    
    '由最小的N个idx开始排列
    ReDim idx(N) As Long
    For i = 0 To N
        idx(i) = i
    Next
    '其中，idx(0)是用来判断结束的,有效范围1到N
    
    Do While idx(0) = 0
        'DoEvents
        PrintComs arr, idx
        Carry idx, M, N
    Loop
End Sub