首页 > 解决方案 > Excel:通过“x”创建列 A 和(单独)无限数量的列 B 的所有可能组合

问题描述

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

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

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

所以例如

Blue   One
Red    Two
Yellow Three

会成为

Blue One
Blue Two
etc

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

标签: excelcombinations

解决方案


这会尽可能多地使用数组,从而限制访问工作表的次数

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

推荐阅读