求排列组合算法

Question

已知n(n>3)个字符串,设n=3
n1="abc"
n2="123"
n3="网" 
求所有可能排列的字符串
如题的答案为
abc abc abc
abc abc 123
abc abc 网abc 123 abc
abc 123 123
abc 123 网abc 网 abc 
abc 网 123
abc 网 网123 abc abc
123 abc 123
123 abc 网123 123 abc
123 123 123
123 123 网123 网 abc 
123 网 123
123 网 网网 abc abc
网 abc 123
网 abc 网网 123 abc
网 123 123
网 123 网网 网 abc 
网 网 123
网 网 网===========
求算法

Answer 1

楼主自己还是要改一下
得出的是非重复排列如：A,B,C的结果是:
ABC
ACB
BAC
BCA
CAB
CBA
    
Private Type T
    Value As String
    Dirty As Boolean
End Type    
Private Function P(sPre As String, a() As T) As String
    Dim nCount As Long
    Dim n As Long
    Dim tmp As T
    Dim cloneA()  As T
    Dim leftData() As T
    Dim bFound As Boolean
    Dim sNewPre As String
    
    nCount = UBound(a)
    bFound = False
    For n = 1 To nCount
        tmp = a(n)
        If tmp.Dirty = True Then
            '已经用过了
        Else
            '没有用过就拿来用吧
            P = tmp.Value
            sNewPre = sPre & tmp.Value
            '用完了就设置dirty=true
            CopyNotDirty a, cloneA
            cloneA(n).Dirty = True
            If CopyNotDirty(cloneA, leftData) = True Then
                Call P(sNewPre, leftData())
            Else
                Debug.Print sNewPre
            End If
            Erase leftData
            bFound = True
        End If
    Next n
    
    End FunctionPrivate Sub Command1_Click()
    Dim a() As String
    Dim b() As T
    Dim i As Long
    Dim Temp As T
    a = Split("A,B,C", ",")
    ReDim b(UBound(a) + 1) As T
    
    For i = LBound(a) To UBound(a)
        Temp.Value = a(i)
        Temp.Dirty = False
        b(i + 1) = Temp
    Next
    'P()里认为数组中从索引1开始才是有效数据
    Call P("", b)
End SubPrivate Function CopyNotDirty(src() As T, des() As T) As Boolean
    Dim i As Long
    Dim tmp As T
    
    ReDim des(0) As T
    For i = 1 To UBound(src)
        tmp = src(i)
        If tmp.Dirty = False Then
            ReDim Preserve des(UBound(des) + 1)
            des(UBound(des)) = tmp
            CopyNotDirty = True
        End If
    Next i
End Function

Answer 2

'想出来后才发现其实很简单
Private Sub Command1_Click()
Dim a(0 To 2) As String
a(0) = "a"
a(1) = "b"
a(2) = "c"
Call PrintArray(a)
End Sub
Public Sub PrintArray(sArray() As String)
Dim sResult() As String
Dim N As Integer
Dim nNum As Integer
Dim i As Integer
N = UBound(sArray) + 1
Debug.Print N
nNum = N ^ N
ReDim sResult(nNum - 1)
Do While nNum > 1
    nNum = nNum / N
    For i = 0 To N ^ N - 1
        sResult(i) = sResult(i) & sArray(Int(i / nNum) Mod N)
    Next
Loop
For i = 0 To N ^ N - 1
    Debug.Print sResult(i)
Next
End Sub