从几个列表创build每个唯一的sorting表

我已经在四位仲裁长度的Excel中列出了名单。

ABCD A1 B1 C1 D1 A2 B2 C2 D2 A3 B3 D3 A4 D4 D5 

我想创build一个表，每个组合从行列表中。

 ABCD A1 B1 C1 D1 A1 B1 C1 D2 ... A4 B3 C2 D5 

有什么简单的方法来做到这一点在Excel中 – 使用Excelfunction，公式或VBA？

Answer 1

一些嵌套的语句应该处理这个问题。 只要把它放在你项目的VBA中，它就会创build一个名为CreateTable（）的macros，它应该把表放在一个新的工作表中。

 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 2

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

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

这是结果表。

我怀疑你会想要删除包含一个或多个（空白）行的行。 这可能是最简单的通过添加一个公式列E沿线

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

对其他列重复此操作，将其添加并按总数sorting。 删除所有具有非零条目的行。

Answer 3

您应该显示您已经尝试过的内容，并详细说明您的数据来自哪里，但是这里有一个VBA解决scheme。 循环遍历给定列中的每个项目的行数与项目总数的组合。

 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 AD, 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 AD 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