Question

我在Excel中有四个列表的任意长度。

A    B    C    D
A1   B1   C1   D1
A2   B2   C2   D2
A3   B3        D3
A4             D4
               D5

我想创建一个表，列表中的每个组合都是行。

A    B    C    D
A1   B1   C1   D1
A1   B1   C1   D2
...
A4   B3   C2   D5

有没有简单的方法在Excel中执行此操作 - 使用Excel功能，公式或VBA？

Answer 1

如果您的四个列表彼此相邻，请突出显示数据并插入数据透视表。

将每个列添加到数据透视表的“rows”部分。依次右键单击每个字段，然后单击“字段设置”。设置布局并打印以显示表格形式，重复的项目标签和没有数据的项目如下。

enter image description here

这是结果表。

enter image description here

我怀疑您要删除包含1个或更多（空白）行的行。通过沿着

行添加公式到E列，这可能是最简单的

=IF(A2="(blank)",1,0)

对其他列重复此操作，添加它们并按总计排序。删除所有具有非零条目的行。

Answer 2

一些嵌套的for语句应该可以解决这个问题。只需将它放在项目的VBA中，它就会创建一个名为CreateTable（）的宏，它应该将表放在一个新的工作表中。

Sub CreateTable()
'Creates a table will all combinations of values from four columns

Dim a, b, c, d As Range

'Activates sheet that has data on it to be copied to table
Worksheets("Sheet1").Activate 'Change Sheet1 to the name of your sheet


'Change A2 to first cell of data you want to be copied over
Set a = Range("A2", Range("A2").End(xlDown))
Set b = Range("B2", Range("B2").End(xlDown))
Set c = Range("C2", Range("C2").End(xlDown))
Set d = Range("D2", Range("D2").End(xlDown))
Dim i As Integer
i = 1 'Row number of the first row of data for the table of combinations

Worksheets("Sheet2").Activate 'Change Sheet2 to name of sheet you want the     table to be put on

For Each cellA In a.Cells
    For Each cellB In b.Cells
       For Each cellC In c.Cells
            For Each cellD In d.Cells
                Worksheets("Sheet2").Cells(i, 1) = cellA.Value
                Worksheets("Sheet2").Cells(i, 2) = cellB.Value
                Worksheets("Sheet2").Cells(i, 3) = cellC.Value
                Worksheets("Sheet2").Cells(i, 4) = cellD.Value
                i = i + 1
            Next cellD
        Next cellC
    Next cellB
Next cellA

End Sub

Answer 3

您应该展示您已经尝试过的内容，并详细说明数据的来源，但这是一个VBA解决方案。循环遍历给定列中的每个项目，以及与项目的总组合一样多的行。

Sub Combination_Table()

Dim rList1 As Range
Dim rList2 As Range
Dim rList3 As Range
Dim rList4 As Range

Dim lLength1 As Long
Dim lLength2 As Long
Dim lLength3 As Long
Dim lLength4 As Long

Dim lRowcounter As Long
Sheets(1).Activate
With Sheets(1)
    lLength1 = .Range("A" & .Rows.Count).End(xlUp).Row - 1
    lLength2 = .Range("B" & .Rows.Count).End(xlUp).Row - 1
    lLength3 = .Range("C" & .Rows.Count).End(xlUp).Row - 1
    lLength4 = .Range("D" & .Rows.Count).End(xlUp).Row - 1

    Set rList1 = .Range("A2:A" & lLength1)
    Set rList2 = .Range("B2:B" & lLength2)
    Set rList3 = .Range("C2:C" & lLength3)
    Set rList4 = .Range("D2:D" & lLength4)

End With

'The above marks the ranges containing the original un-combined lists,
'with no duplicates and assuming row 1 is the header and all data is on
'columns A-D, without blanks.

rowcounter = 0
Sheets(2).Activate

For i = 1 To lLength1
    For j = 1 To lLength2
        For k = 1 To lLength3
            For l = 1 To lLength4
                rowcounter = rowcounter + 1

                Sheets(2).Range("A" & rowcounter).Formula = rList1(i, 1).Text
                Sheets(2).Range("B" & rowcounter).Formula = rList2(j, 1).Text
                Sheets(2).Range("C" & rowcounter).Formula = rList3(k, 1).Text
                Sheets(2).Range("D" & rowcounter).Formula = rList4(l, 1).Text
'This changes the text in columns A-D for the given rowcount, to the current
'iteration of the current looped value from the above lists
            Next l
        Next k
    Next j
Next i

End Sub

Answer 4

这也工作，这更简单。

    Sub t()
    Dim sht As Worksheet
    Dim LastRow As Long, lastcol As Long
    Dim i As Integer, j As Integer, k As Integer

    Set sht = ThisWorkbook.Sheets("Sheet1")

      LastRow = sht.Range("A1").CurrentRegion.Rows.Count
      lastcol = sht.Range("A1").CurrentRegion.Columns.Count

        k = 0

        For i = 2 To LastRow
        j = 1
        k = k + 1
            For j = 1 To lastcol
            sht.Cells(i, j).Value = sht.Cells(1, j) & k
            Next
    Next
    End Sub

从几个列表创建每个独特的综合表

4 个答案: