VBA Excel排序功能

Question

我是VBA的新手，我正试图想出一种方法来对Excel-Table进行排序

问题：我需要对此类事进行排序

Col1	Col2

ABC123	XYZ
ABC123	XYZ
ABC123	XYZ
ABC123	XYZ
ABC123	KLJ
ABC123	KLJ
ABC123	KLJ
ABC123	KLJ
ABC123	III
ABC123	III
ABC123	III
DEF456	uuu
DEF456	LKK
DEF456	LKK
DEF456	WWW
DEF456	WWW
ZZZ	KLMNOP
ZZZ	KLMNOP
ZZZ	KLMNOP
ZZZ	KLMNOP
ZZZ	jjj
ZZZ	jjj

这是输出：

1	ABC123	1	XYZ	4 
		2	KLJ	4
		3	III	3
2	DEF456	1	uuu	1
		2	LKK	2
		3	WWW	2
3	ZZZ	1	KLMNOP	4
		2	jjj	2

Answer 1

如汤姆所述，使用数据透视表：

结果（在将字段添加为行并对值区域进行计数之后）：

Answer 2

＆＃13;

＆＃13;

Private Sub a()

Dim toAdd As Boolean, uniqueNumbers As Integer, i As Integer, j As Integer, z As Integer
z = 1
Cells(1, 3).Value = z
Cells(1, 4).Value = Cells(1, 1).Value
uniqueNumbers = 1
toAdd = True

For i = 1 To ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row
    For j = 1 To uniqueNumbers
        If Cells(i, 1).Value = Cells(j, 4).Value Then
            toAdd = False
        End If
    Next j
    
    If toAdd = True Then
        z = z + 1
        Cells(uniqueNumbers, 3).Value = z
        Cells(uniqueNumbers, 4).Value = Cells(i, 1).Value
        uniqueNumbers = uniqueNumbers '+ 1
    End If
    toAdd = True

    uniqueNumbers = uniqueNumbers + 1
    
Next i

End Sub

Private Sub b()

Dim toAdd As Boolean, uniqueNumbers As Integer, i As Integer, j As Integer, z As Integer, s As Integer, a As String, k As Integer

z = 1
j = 1
s = 1
k = 1

a = Cells(1, 4).Value
Cells(1, 5).Value = z
Cells(1, 6).Value = Cells(1, 2).Value
uniqueNumbers = 1
toAdd = True

For i = 1 To ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row
    For j = k To uniqueNumbers
    'If j = 2800 Then Stop
        'If Cells(i, 2).Value = Cells(j, 6).Value And a = Cells(i, 1).Value Then
        If Cells(i, 2).Value = Cells(j, 6).Value And a = Cells(i, 1).Value Then
            toAdd = False
        End If
    Next j
    
    If toAdd = True Then
          
        If Cells(uniqueNumbers, 4).Value = "" Then
            z = z + 1
            Cells(uniqueNumbers, 5).Value = z
        Else
            a = Cells(i, 4).Value
            k = i
            z = 1
            Cells(uniqueNumbers, 5).Value = z
        End If
        
        Cells(uniqueNumbers - s + 1, 7).Value = s - 1
        
        Cells(uniqueNumbers, 6).Value = Cells(i, 2).Value
        uniqueNumbers = uniqueNumbers '+ 1
        s = 1
    End If
    toAdd = True

    uniqueNumbers = uniqueNumbers + 1
    s = s + 1
    If i = 666 Then Stop
Next i

End Sub

＆＃13;

＆＃13;

＆＃13;

Answer 3

我一直使用的简单解决方案是自动插入Pivot。假设您在Sheet1的A＆amp; B列中具有上述数据，则以下代码可能有所帮助。

Sub InsertPivot()
    ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:= _
        "Sheet1!R1C1:R23C2", Version:=xlPivotTableVersion14).CreatePivotTable _
        TableDestination:="Sheet1!R30C1", TableName:="PivotTable1", DefaultVersion _
        :=xlPivotTableVersion14
    Sheets("Sheet1").Select
    Cells(30, 1).Select
    With ActiveSheet.PivotTables("PivotTable1").PivotFields("Col1")
        .Orientation = xlRowField
        .Position = 1
    End With
    ActiveSheet.PivotTables("PivotTable1").AddDataField     ActiveSheet.PivotTables( _
        "PivotTable1").PivotFields("Col2"), "Count of Col2", xlCount
    'Range("B34").Select
    With ActiveSheet.PivotTables("PivotTable1")
        .InGridDropZones = True
        .RowAxisLayout xlTabularRow
    End With
    With ActiveSheet.PivotTables("PivotTable1").PivotFields("Col2")
        .Orientation = xlRowField
        .Position = 2
    End With
End Sub