求助数据组合VBA

三票

求助数据组合VBA

grf1973

。。。。。。。。。。。。。。。。

grf1973

用JSA要方便很多，一个filter就把所有空格去掉了。

三票

grf1973 发表于 2024-6-14 10:24
。。。。。。。。。。。。。。。。

感谢：grf1973老师！！发现两个问题：1、比如E:N列、P:Y列、AA:AJ列 ，三列中有1部分数据一个时报错。2、三部分数据有一部没有数据则组合剩下的两部数据（例：P:Y列没有数据则只组合E:N列、AA:AJ列数据。

grf1973

加一些判断即可。

grf1973

。。。。。。。。。。。。。。。。

gwjkkkkk

Option Explicit
Sub test()
    Dim ar(), j&
    ReDim ar(1 To 3)
    For j = 1 To 3
        ar(j) = Cells(3, (j - 1) * 11 + 5).CurrentRegion.Value
    Next
    ar = cartesianProduct2(ar)
   
    [AL2].CurrentRegion.ClearContents
    [AL2].Resize(UBound(ar), UBound(ar, 2)) = ar
End Sub

Function cartesianProduct2(ByVal ar) As Variant
    Dim br&(), vResult(), iGroup&, i&, j&, m&, n&, x&
   
    n = UBound(ar): iGroup = 1
    For i = 1 To UBound(ar)
         m = m + UBound(ar(i), 2)
         iGroup = iGroup * UBound(ar(i))
    Next i
    ReDim br(1 To n)
    ReDim vResult(1 To iGroup, 1 To m)
    For j = 1 To n: br(j) = 1: Next

    iGroup = 0
    Do
        iGroup = iGroup + 1
        x = 0
        For j = 1 To n
            For i = 1 To UBound(ar(j), 2)
                If Len(ar(j)(br(j), i)) Then
                x = x + 1
                vResult(iGroup, x) = ar(j)(br(j), i)
                End If
            Next i
        Next
        
        For j = n To 1 Step -1
            br(j) = br(j) + 1
            If br(j) <= UBound(ar(j)) Then Exit For Else br(j) = 1
        Next
    Loop Until j = 0
   
    cartesianProduct2 = vResult
End Function

gwjkkkkk

参与 一下。。。