N个单元，每个单元可以取值1-M，要得出所有组合，请问如何实现？ - 编程论坛

#2

wmf20142015-10-20 22:00

这不是组合，这是穷尽。计数器法可穷尽出所有。

#3

风吹过b2015-10-21 09:22

Option Explicit

Dim a() As Long             '所有的数据，二维数组

Dim n As Long               '第一维
Dim m() As Long             '第二维每行个数

Private Sub Command1_Click()

n = 3
ReDim m(n)

Dim maxm As Long
Dim i As Long, j As Long

Randomize

For i = 1 To n
    m(i) = Rnd() * 6 + 1
    If maxm < m(i) Then maxm = m(i)         '最大个数，确定数组第二维
Next i

ReDim a(n, maxm)

For i = 1 To n
    For j = 1 To m(i)
        a(i, j) = j
    Next j
Next i

Call DG("", 1, n, a(), m(1))

End Sub

Public Sub DG(前缀 As String, 层数 As Long, 总层数 As Long, 数据() As Long, 数据个数 As Long)

Dim i As Long
Dim s As String
If 层数 = 总层数 Then
    For i = 1 To 数据个数
        s = 前缀 & 数据(层数, i)
        Debug.Print s
    Next i
Else
    For i = 1 To 数据个数
        s = 前缀 & 数据(层数, i)
        Call DG(s, 层数 + 1, 总层数, a(), m(层数 + 1))
    Next i
End If
End Sub
--------------------------
有点属于递归。不知道数据再大一点会不会爆内存。

#4

wmf20142015-10-21 11:45

给一个计数器法组合字符串的方法，在新工程里添加一个按钮，拷贝下列代码运行即看到效果

Private Function inc(s() As String, c() As Integer, l As Integer) As String
  '返回计数器指示的字符组合，同时计数器+1
  Dim i As Integer, a As String, j As Integer
  a = ""
  If c(0) < 0 Then Exit Function
  For i = 0 To l
    a = a & Mid(s(i), c(i) + 1, 1)
  Next
  j = 1
  For i = 0 To l
    c(i) = c(i) + j
    j = 0
    If c(i) + 1 > Len(s(i)) Then
      c(i) = 0
      j = 1
    End If
  Next
  If j = 1 Then c(0) = -1
  inc = a
End Function

Private Sub Command1_Click()
  Dim c(2) As Integer, s(2) As String, a As String, i
  s(0) = "AB": s(1) = "123": s(2) = "XY"
  c(0) = 0: c(1) = 0: c(2) = 0: a = "": i = 0
  While c(0) >= 0
    a = a & inc(s, c, 2) & ","
    i = i + 1
  Wend
  MsgBox a & i & "种组合"
End Sub