Question

我在Excel中有一个列表列表。第一列中有一些规范（名称，年龄，国家等），第二列中有值。我不想一遍又一遍地重复相同的规范。我想在图片中展示什么。我尝试了Model.where(:type_id => [1, 2])，但它没有完美地工作，因为列表不包含相同的规范。我怎样才能做到这一点？

Answer 1

VBA宏可以生成结果，以及第一列结果的参数列表。

要输入此宏（子）， alt-F11 将打开Visual Basic编辑器。确保在Project Explorer窗口中突出显示您的项目。然后，从顶部菜单中选择插入/模块和将下面的代码粘贴到打开的窗口中。

请务必按照宏中的注释中所述设置参考

要使用此宏（子）， alt-F8 将打开宏对话框。按名称选择宏，然后 RUN 。

此宏使用第一列中的参数列表生成列表。如果可以的话，可以很容易地重写它以在第一行中包含参数列表。

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

编辑：修改了宏以反映“真实数据”

请注意：您需要为结果添加第二个工作表。我把它命名为“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

EDIT2：此宏是对上述内容的修改，它以相反的方向列出结果。它可能更有用。

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

Answer 2

使用以下ARRAY公式。

Cell 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 来评估公式，因为它是一个数组公式。

如何在excel中对列表进行分组？

2 个答案: