程序代码:
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列时,运行速度就比较慢了。