EXCEL - VBA 資料分組(好用的資料分類)

感謝星展銀行 請先去除標題後再將混亂資料A欄先行排序 ,將下列程式複製至VBA的程式編輯區 即可完成
程式如下
Sub 整合()
'偵測項目範圍
Count = 0
Cells(1, 1).Select
ybegin = ActiveCell.Row
Selection.End(xlToRight).Select
yright = ActiveCell.Column
Cells(1, 1).Select
Selection.End(xlDown).Select
yend = ActiveCell.Row
Cells(ybegin, 1).Select
' 分類項目偵測

For i = 1 To yend + 1 Step 1
If ActiveCell.Offset(i, 0).Value = ActiveCell.Offset(i + 1, 0).Value Then
Count = Count

Else
Count = Count + 1
End If
Next

' 增加工作表項目 , 依據分類項目
For i = 1 To Count Step 1
Sheets.Add
Sheets(1).Name = i

Next

' 資料分組

xsheet = Count + 1
Sheets(xsheet).Select
sheetcount = 1



For i = 1 To yend + 1 Step 1
If Cells(i, 1).Value = Cells(i + 1, 1).Value Then
For j = 1 To yright Step 1
Sheets(sheetcount).Cells(i, j).Value = Sheets(xsheet).Cells(i, j).Value

Next


Else
For j = 1 To yright Step 1
Sheets(sheetcount).Cells(i, j).Value = Sheets(xsheet).Cells(i, j).Value

Next

sheetcount = sheetcount + 1


End If

Next

' 清除空白
For i = 1 To Count
Sheets(i).Select
Cells(1, 1).Select

Selection.End(xlDown).Select
yrow = ActiveCell.Row
Cells(1, 1).Select

For y = 1 To yrow Step 1
If Cells(1, 1).Value = Empty Then
Rows("1:1").Select
Selection.Delete Shift:=xlUp
Else
End If


Next


Next



End Sub

註 : 標題請另行設計還原
排序請自行設計