VBA的Excel排序功能

Question

我是新來的VBA，我試圖想出一個辦法來排序我的Excel工作表

問題：我需要梳理這樣的事情

Col1 \t Col2 
 

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

而這是輸出：

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

Answer 1

如由湯姆所提到的，使用透視表：

Answer 2

：

結果（添加字段爲行和承擔值區域的計數之後）

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

Answer 3

簡單的解決方案我一直使用的是自動插入一個Pivot。假設您在A & B Sheet1的列中有以上提及的數據，以下代碼可能有所幫助。

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