如何在Excel中分组列表？
我有一个列表在Excel中的列表。 第一列有一些规格（名称，年龄，国家等）和第二列的值。 我不想一遍又一遍地重复相同的规格。 我想在图片中展示的东西 我尝试了=VLOOKUP()但它并不完美，因为列表不包括相同的规格。 我怎样才能做到这一点？
VBAmacros可以生成结果， 也可以生成第一列结果的参数列表。
要input这个macros（Sub）， alt-F11打开Visual Basic编辑器。 确保您的项目在“项目浏览器”窗口中突出显示。 然后，从顶部菜单中select插入/模块，然后将下面的代码粘贴到打开的窗口中。
请务必按照macros中的注释中所述设置参考
要使用这个macros（Sub）， alt-F8打开macros对话框。 按名称selectmacros，并运行 。
该macros将在第一列中生成带有参数列表的列表。 如果可以的话，可以很容易地将第一行中的参数列表重写。
Option Explicit 'Set Reference to Microsoft Scripting Runtime Sub GroupLists() Dim wsSrc As Worksheet, wsRes As Worksheet, rRes As Range Dim vSrc As Variant, vRes As Variant Dim dictParams As Dictionary Dim sParam As String Dim I As Long, J As Long, K As Long Dim V As Variant Set wsSrc = Worksheets("sheet1") Set wsRes = Worksheets("sheet1") Set rRes = wsRes.Cells(1, 5) With wsSrc vSrc = .Range(.Cells(1, 1), .Cells(.Rows.Count, 1).End(xlUp)).Resize(columnsize:=2) End With 'Get unique list of Parameters with row number 'Also count the number of entries for number of columns in final result J = 0 Set dictParams = New Dictionary K = 0 'row number for parameter For I = 1 To UBound(vSrc, 1) J = J + 1 'column count Do If Not dictParams.Exists(vSrc(I, 1)) Then K = K + 1 dictParams.Add Key:=vSrc(I, 1), Item:=K End If I = I + 1 If I > UBound(vSrc) Then Exit Do Loop Until vSrc(I, 1) = "" If I > UBound(vSrc) Then Exit For Next I 'Create results array ReDim vRes(1 To dictParams.Count, 1 To J + 1) 'Populate Column 1 For Each V In dictParams.Keys vRes(dictParams(V), 1) = V Next V 'Populate the data J = 1 'column number For I = 1 To UBound(vSrc, 1) J = J + 1 Do sParam = vSrc(I, 1) vRes(dictParams(sParam), J) = vSrc(I, 2) I = I + 1 If I > UBound(vSrc) Then Exit Do Loop Until vSrc(I, 1) = "" If I > UBound(vSrc) Then Exit For Next I 'Write the results Set rRes = rRes.Resize(UBound(vRes, 1), UBound(vRes, 2)) rRes.EntireColumn.Clear rRes = vRes End Sub
编辑：macros修改，以反映“真实的数据”
请注意：您需要为结果添加第二个工作表。 我把它命名为“Sheet2”
Option Explicit 'Set Reference to Microsoft Scripting Runtime Sub GroupLists() Dim wsSrc As Worksheet, wsRes As Worksheet, rRes As Range Dim vSrc As Variant, vRes As Variant Dim dictParams As Dictionary Dim sParam As String Dim I As Long, J As Long, K As Long Dim V As Variant Dim sDelim As String 'Differentiates each record Set wsSrc = Worksheets("sheet1") Set wsRes = Worksheets("sheet2") Set rRes = wsRes.Cells(1, 1) With wsSrc vSrc = .Range(.Cells(1, 1), .Cells(.Rows.Count, 1).End(xlUp)).Resize(columnsize:=2) sDelim = vSrc(1, 1) End With 'Get unique list of Parameters with row number 'Also count the number of entries for number of columns in final result J = 0 Set dictParams = New Dictionary K = 0 'row number for parameter For I = 1 To UBound(vSrc, 1) J = J + 1 'column count Do If Not dictParams.Exists(vSrc(I, 1)) Then K = K + 1 dictParams.Add Key:=vSrc(I, 1), Item:=K End If I = I + 1 If I > UBound(vSrc) Then Exit Do Loop Until vSrc(I, 1) = sDelim If I > UBound(vSrc) Then Exit For Else I = I - 1 End If Next I 'Create results array ReDim vRes(1 To dictParams.Count, 1 To J + 1) 'Populate Column 1 For Each V In dictParams.Keys vRes(dictParams(V), 1) = V Next V 'Populate the data J = 1 'column number For I = 1 To UBound(vSrc, 1) J = J + 1 Do sParam = vSrc(I, 1) vRes(dictParams(sParam), J) = vSrc(I, 2) I = I + 1 If I > UBound(vSrc) Then Exit Do Loop Until vSrc(I, 1) = sDelim If I > UBound(vSrc) Then Exit For Else I = I - 1 End If Next I 'Write the results Set rRes = rRes.Resize(UBound(vRes, 1), UBound(vRes, 2)) rRes.EntireColumn.Clear rRes = vRes End Sub
编辑2：这个macros是上面的修改，它以相反的方向列出结果。 这可能会更有用。
Option Explicit 'Set Reference to Microsoft Scripting Runtime Sub GroupListsVertical() Dim wsSrc As Worksheet, wsRes As Worksheet, rRes As Range Dim vSrc As Variant, vRes As Variant Dim dictParams As Dictionary Dim sParam As String Dim I As Long, J As Long, K As Long Dim V As Variant Dim sDelim As String 'Differentiates each record Set wsSrc = Worksheets("sheet1") Set wsRes = Worksheets("sheet3") Set rRes = wsRes.Cells(1, 1) With wsSrc vSrc = .Range(.Cells(1, 1), .Cells(.Rows.Count, 1).End(xlUp)).Resize(columnsize:=2) sDelim = vSrc(1, 1) End With 'Get unique list of Parameters with row number 'Also count the number of entries for number of columns in final result J = 0 Set dictParams = New Dictionary K = 0 'column number for parameter For I = 1 To UBound(vSrc, 1) J = J + 1 'row count Do If Not dictParams.Exists(vSrc(I, 1)) Then K = K + 1 dictParams.Add Key:=vSrc(I, 1), Item:=K End If I = I + 1 If I > UBound(vSrc) Then Exit Do Loop Until vSrc(I, 1) = sDelim If I > UBound(vSrc) Then Exit For Else I = I - 1 End If Next I 'Create results array ReDim vRes(1 To J + 1, 1 To dictParams.Count) 'Populate row 1 For Each V In dictParams.Keys vRes(1, dictParams(V)) = V Next V 'Populate the data J = 1 'row number For I = 1 To UBound(vSrc, 1) J = J + 1 Do sParam = vSrc(I, 1) vRes(J, dictParams(sParam)) = vSrc(I, 2) I = I + 1 If I > UBound(vSrc) Then Exit Do Loop Until vSrc(I, 1) = sDelim If I > UBound(vSrc) Then Exit For Else I = I - 1 End If Next I 'Write the results Set rRes = rRes.Resize(UBound(vRes, 1), UBound(vRes, 2)) rRes.EntireColumn.Clear rRes = vRes rRes.EntireColumn.AutoFit End Sub
使用以下ARRAY公式。
单元格F2公式
=IFERROR(INDEX($B$1:$B$20,SMALL(IF($A$1:$A$20=$E2,ROW($B$1:$B$20),""),COLUMN(A:A))),"")
单元格E19公式
=IFERROR(INDEX($B$1:$B$20,SMALL(IF($A$1:$A$20=$E2,ROW($B$1:$B$20),""),COLUMN(A:A))),"")
按CTRL + SHIFT + ENTER来评估公式，因为它是一个数组公式。
