vba怎样用指定3个数组合，每一行有4个数

raylenewu

lsdongjh 发表于 2020-1-10 09:35
arrList = Array("D0", "D1", "D2")
    myCombination arrList, 0, 0, 3, arrResult

但是还有D3 ，D4，D5，D6， 那些。
第四行 和前面三行不一样，前面三行没有D3 ，D4，D5，D6这些的。
这个要怎样修改。

yjh_27

raylenewu 发表于 2020-1-10 09:08
谢谢。能再帮我写一下代码吗？
我上传了附件

数组1是从n个元素中取m个可重复（取出后放回再取）的组合

数组2是从3组元素中分别取规定元素（1、4、4）的分组组合
分组元素应这样

一把小刀闯天下

'1楼附件，，，

Option Explicit

Sub test()
  Dim arr, crr, i, j, k, kk, m, s
  arr = [g5:n24].Value
  ReDim cnt(1 To 4), brr(10 ^ 4, 1 To 4) As String
  For j = 1 To 4
    For i = 1 To UBound(arr, 1)
      arr(i, j) = arr(i, 2 * j - 1)
    Next
    For i = 1 To UBound(arr, 1)
      If Len(arr(i, j)) Then
        m = m + 1: arr(m, j) = arr(i, j)
        If m <> i Then arr(i, j) = vbNullString
      End If
    Next
    cnt(j) = m: m = 0
  Next
  For i = 1 To 4
    brr(0, i) = arr(1, i)
  Next
  m = 0: s = [j28].Value: crr = brr
  For i = 2 To cnt(1)
    For j = i To cnt(2)
      For k = j To cnt(3)
        For kk = k To cnt(4)
          m = m + 1
          brr(m, 1) = arr(i, 1): brr(m, 2) = arr(j, 2)
          brr(m, 3) = arr(k, 3): brr(m, 4) = arr(kk, 4)
          crr(m, 1) = s & brr(0, 1) & brr(m, 1)
          crr(m, 2) = s & brr(0, 2) & brr(m, 2)
          crr(m, 3) = s & brr(0, 3) & brr(m, 3)
          crr(m, 4) = s & brr(0, 4) & brr(m, 4)
        Next
      Next
    Next
  Next
  With [e29]
    .Resize(UBound(brr, 1), 2 * 4 + 1).ClearContents
    .Resize(m + 1, 4) = brr
    .Offset(, 4 + 1).Resize(m + 1, 4) = crr
  End With
End Sub

raylenewu

yjh_27 发表于 2020-1-10 13:20
数组1是从n个元素中取m个可重复（取出后放回再取）的组合

数组2是从3组元素中分别取规定元素（1、4、4 ...

嗯，是的哦