| 网站首页 | 业界新闻 | 小组 | 威客 | 人才 | 下载频道 | 博客 | 代码贴 | 在线编程 | 编程论坛
欢迎加入我们,一同切磋技术
用户名:   
 
密 码:  
共有 448 人关注过本帖
标题:请教一个循环算法
只看楼主 加入收藏
vbfans01
Rank: 1
等 级:新手上路
帖 子:4
专家分:0
注 册:2015-7-10
结帖率:0
收藏
已结贴  问题点数:20 回复次数:3 
请教一个循环算法
怎样才能列出组合数组中所有的可能
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列
2015-07-10 06:25
风吹过b
Rank: 20Rank: 20Rank: 20Rank: 20Rank: 20
等 级:贵宾
威 望:364
帖 子:4947
专家分:30084
注 册:2008-10-15
收藏
得分:10 
程序代码:
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列时,运行速度就比较慢了。

授人于鱼,不如授人于渔
早已停用QQ了
2015-07-10 09:33
lianyicq
Rank: 12Rank: 12Rank: 12
等 级:贵宾
威 望:26
帖 子:737
专家分:3488
注 册:2013-1-26
收藏
得分:10 
回复 楼主 vbfans01
为什么不用多重循环?
用递归和循环写了一个,给你参考吧。
程序代码:
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 编辑 ]

大开眼界
2015-07-10 16:22
vbfans01
Rank: 1
等 级:新手上路
帖 子:4
专家分:0
注 册:2015-7-10
收藏
得分:0 
先谢谢各位,我去研究一下你们发的代码
2015-07-10 23:21
快速回复:请教一个循环算法
数据加载中...
 
   



关于我们 | 广告合作 | 编程中国 | 清除Cookies | TOP | 手机版

编程中国 版权所有,并保留所有权利。
Powered by Discuz, Processed in 0.022802 second(s), 7 queries.
Copyright©2004-2024, BCCN.NET, All Rights Reserved