怎样才能列出组合数组中所有的可能
dim ArrTxt(4,6)
ArrTxt(1,0)=4 '第1列有4行
ArrTxt(1,1)="A1"
ArrTxt(1,2)="A2"
ArrTxt(1,3)="A3"
ArrTxt(1,4)="A4"

ArrTxt(2,0)=3'第2列有3行
ArrTxt(2,1)="B1"
ArrTxt(2,2)="B2"
ArrTxt(2,3)="B3"

ArrTxt(3,0)=2'第3列有2行
ArrTxt(3,1)="C1"
ArrTxt(3,2)="C2"

ArrTxt(4,0)=3'第4列有3行
ArrTxt(4,1)="D1"
ArrTxt(4,2)="D2"
ArrTxt(4,3)="D3"
'-------
'A1  B1 C1 D1
'A2  B2 C2 D2
'A3  B3      D3
'A4

列出所有的组合，如下
A1B1C1D1
A1B1C1D2
A1B1C1D3

A1B1C2D1
A1B1C2D2
A1B1C2D3
......
。。。。

怎样写代码？（列数不一定是4列

Option Explicit

Const 列 = 6                '最大列

Dim ArrTxt(列, 10)          '原始数据

Private Sub Command1_Click()

Dim i As Long
If IsNumeric(Text1.Text) Then                   '输入了数字
    i = Val(Text1.Text)                         '转格式
    If i <= 列 Then Call PL(Val(Text1.Text))    '如果没有超过最大列，则调用
End If

End Sub

Private Sub Form_Load()
Dim i As Long
Dim j As Long
Dim m As Long

Randomize
'随机产生各列的数据
For i = 1 To 列
    m = Int(Rnd() * 10) + 1                     '随机产生 列数据个数
    ArrTxt(i, 0) = m
    For j = 1 To m
        ArrTxt(i, j) = Chr(64 + i) & j          '生成数据
    Next j
Next i

End Sub


Public Sub PL(cs As Long)

Dim i As Long
Dim j As Long
Dim o As Long
Dim s As String
Dim fj() As String


'第一列的要特殊排列，因为S没有内容，直接去分解会导致出错
s = ""
For i = 1 To ArrTxt(1, 0)
    s = s & ArrTxt(1, i) & ","
Next i

For i = 2 To cs                 '从第二列起
    s = Left(s, Len(s) - 1)     '去掉最后一个逗号
    fj = Split(s, ",")          '分解
    s = ""                      '缓冲清空
    For j = 0 To UBound(fj)     '所有的元素
        For o = 1 To ArrTxt(i, 0)           '新的一列
            s = s & fj(j) & ArrTxt(i, o) & ","      '附加进去
        Next o
    Next j
Next i
List1.Clear                     '显示，先清
s = Left(s, Len(s) - 1)         '去掉最后一个逗号
fj = Split(s, ",")              '
For j = 0 To UBound(fj)
    List1.AddItem fj(j)
Next j
End Sub

我的算法有问题。郁闷。
虽然最终的结果还可能， 但超过 6列时，运行速度就比较慢了。

为什么不用多重循环？
用递归和循环写了一个，给你参考吧。

Option Explicit

Dim n(1 To 4) As Integer
Dim m(1 To 4) As Integer
Private Sub Command1_Click()
  Dim i As Integer
  For i = 1 To 4
    m(1) = i
    permutate 1, i
    Text1.Text = Text1.Text & vbCrLf & vbCrLf
  Next
End Sub

Private Sub Form_Load()
  n(1) = 4
  n(2) = 3
  n(3) = 2
  n(4) = 3
End Sub
Sub permutate(x As Integer, y As Integer)
  Dim i As Integer
  If x > 3 Then Text1.Text = Text1.Text & "A" & m(1) & "B" & m(2) & "C" & m(3) & "D" & m(4) & vbTab: Exit Sub
  For i = 1 To n(x + 1)
    m(x + 1) = i
    permutate x + 1, i
  Next
End Sub

...
代码可以更简单。
更换

Private Sub Command1_Click()
  permutate 0, 1
End Sub

[ 本帖最后由 lianyicq 于 2015-7-11 10:18 编辑 ]

先谢谢各位，我去研究一下你们发的代码