我有一个 Excel 中的列表列表。第一列中有一些规范(姓名、年龄、国家/地区等),第二列中有一些值。我不想一遍又一遍地重复相同的规范。我想在图片中展示什么。我尝试了 =VLOOKUP()
但它不能完美工作,因为列表不包含相同的规范。我怎样才能实现这个目标?
最佳答案
VBA 宏可以生成结果,以及第一列结果的参数列表。
要输入此宏(子),alt-F11 打开 Visual Basic 编辑器。 确保您的项目在“项目资源管理器”窗口中突出显示。 然后,从顶部菜单中选择插入/模块并 将下面的代码粘贴到打开的窗口中。
请务必按照宏中注释中的说明设置引用
要使用此宏(子),alt-F8 打开宏对话框。按名称选择宏,然后运行。
该宏生成列表,参数列表位于第一列。如果更可取的话,可以很容易地将其重写为将参数列表放在第一行。
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
编辑:修改宏以反射(reflect)“真实数据”
请注意:您需要为结果添加第二个工作表。我将其命名为“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:此宏是上述宏的修改,它以相反的方向列出结果。它可能更有用。
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
关于excel - 如何在Excel中对列表进行分组?,我们在Stack Overflow上找到一个类似的问题: https://stackoverflow.com/questions/42590742/