VBA实现排列组合（可重复）

Sub PLZH()
    Dim src(4 - 1) As String
    
    src(0) = "1"
    src(1) = "2"
    src(2) = "3"
    src(3) = "4"
    
    Dim Result() As String
    ReDim Result(4 ^ 3 - 1, 0) As String
    
    Dim Count As Long
    Dim tmp As String
    
    Dim n0 As Long, n1 As Long, n2 As Long
    For n0 = 0 To 4 - 1
        For n1 = 0 To 4 - 1
            For n2 = 0 To 4 - 1
                tmp = src(n0) & src(n1) & src(n2)
                Result(Count, 0) = tmp
                Count = Count + 1
            Next
        Next
    Next
    
    Range("A1").Resize(Count, 1).Value = Result
End Sub

'有点类似加法的10进1的方法
'对于排列的结果，m个位置相对于ArrKeys下标的取值范围都是1-n（注意下标0的情况）
'初始m个位置都取下标0
'm个位置的第1个位置开始逐步加1，直到>n的时候，进一位，第2位变为1，并且本身变为了0
'然后继续从0到n，继续进位，直到第2位也>n，进位，第3位变为1
'循环到m的位置>n停止

'函数返回结果的个数，-1表示出错了
'为了和数字的加法类似，程序是从下标m-1开始逐步加1的
Function GetPermutation(ArrKeysZeroBase() As String, m As Long, Result() As String) As Long
    Dim n As Long
    
    n = UBound(ArrKeysZeroBase) - LBound(ArrKeysZeroBase) + 1
    If m = 0 Then
        GetPermutation = -1
        Exit Function
    End If
    
    GetPermutation = n ^ m
    ReDim Result(GetPermutation - 1) As String
    
    '记录m个位置的index
    Dim p() As Long
    '记录当前正在处理的p()index
    Dim pp As Long
    ReDim p(m - 1) As Long
    
    '记录临时的数据，方便用join函数
    Dim tmp() As String
    Dim i As Long
    ReDim tmp(m - 1) As String
    
    Dim Count As Long
    Do
        '提取结果数据
        For i = 0 To m - 1
            tmp(i) = ArrKeysZeroBase(p(i))
        Next
        Result(Count) = VBA.Join(tmp, "")
        Count = Count + 1
        
        pp = m - 1
        p(pp) = p(pp) + 1
        
        'p数组元素的最大值是n-1
        Do While p(pp) = n
            '进位
             p(pp) = 0
             pp = pp - 1
             If pp = -1 Then Exit Function
             p(pp) = p(pp) + 1
        Loop
        
    Loop While 1
End Function

Sub TestPermutation()
    Dim arr(3) As String
    
    arr(0) = "1"
    arr(1) = "2"
    arr(2) = "3"
    arr(3) = "4"
    
    Dim Result() As String
    GetPermutation arr, 3, Result
    
    Range("A1").Resize(UBound(Result) + 1, 1).Value = Application.WorksheetFunction.Transpose(Result)
End Sub