Excel：通过“x”创建列 A 和（单独）无限数量的列 B 的所有可能组合

Posted 2023-03-31

【中文标题】Excel：通过“x”创建列 A 和（单独）无限数量的列 B 的所有可能组合

【英文标题】：Excel: Create all Possible Combinations of Column A and (individually) an unlimited number of Columns B thru "x"

【发布时间】：2018-12-17 15:13:44

【问题描述】：

我在 A 列中有数据，需要与 B、C、D 等列中的每个数据进行所有组合的结果...

所以我不需要所有列的组合，我需要 AB、AC、AD、AE 等...

为了我的目的，更容易将每个单元格的结果组合在一起，现在组合的数据之间有一个空格

例如

Blue   One
Red    Two
Yellow Three

会变成

Blue One
Blue Two
etc

希望能够指定组合的顺序，例如，列 B、C、D 等中每一个的所有可能性...其中 A 列单元格数据被附加而不是继续

【问题讨论】：

这需要 vba。公式不会结束列计数。

【参考方案1】：

这尽可能使用数组，从而限制访问工作表的次数

Sub mygrouping()
    With Worksheets("Sheet6") ' change to your sheet
        Dim rngA As Variant
        rngA = .Range("A1", .Cells(.Rows.Count, 1).End(xlUp)).Value

        Dim rngOthers As Variant
        ReDim rngOthers(1 To Application.CountA(.Range("B1", .Cells(1040000, .Cells(1, .Columns.Count).End(xlToLeft).Column)))) As Variant
        Dim j As Long, k As Long, i As Long
        k = 1
        For j = 2 To .Cells(1, .Columns.Count).End(xlToLeft).Column
            rngintm = .Range(.Cells(1, j), .Cells(.Rows.Count, j).End(xlUp)).Value
            For i = 1 To UBound(rngintm, 1)
                If rngintm(i, 1) <> "" Then
                    rngOthers(k) = rngintm(i, 1)
                    k = k + 1
                End If
            Next i
        Next j
        Dim outarr() As Variant
        ReDim outarr(1 To UBound(rngA, 1) * UBound(rngOthers), 1 To 1)
        k = 1
        For i = 1 To UBound(rngA, 1)
            For j = 1 To UBound(rngOthers)
                outarr(k, 1) = rngA(i, 1) & rngOthers(j)
                k = k + 1
            Next j
        Next i


        'Outputs to another sheet change to your sheet name and desired location
        Worksheets("Sheet7").Range("A1").Resize(UBound(outarr, 1), 1).Value = outarr

    End With
End Sub