Sub 分类汇总()
Dim i, j, k As Long
Worksheets(2).Activate
Worksheets(2).Range("A:AZ").Clear
Worksheets(2).Activate
Worksheets(2).Range("A:A").Value = Worksheets(1).Range("A:A").Value
t = Worksheets(2).Cells(1, 1)
Worksheets(2).Cells(1, 1) = 1 & t
S = Worksheets(2).Cells(Rows.Count, 1).End(xlUp).Row
Worksheets(2).Range(Cells(1, 1), Cells(S, 1)).Select
With ActiveSheet.Sort
With .SortFields
.Clear
.Add Key:=Range("A2"), Order:=xlDescending
End With
.Header = xlGuess
.MatchCase = False
.SortMethod = xlPinYin
.Orientation = xlSortColumns
.SetRange Rng:=Range(Cells(2, 1), Cells(S, 1))
.Apply
End With
Worksheets(2).Range("A:A").RemoveDuplicates 1
t = Worksheets(2).Cells(1, 1)
Worksheets(2).Cells(1, 1) = Right(t, Len(t) - 1)
S = Worksheets(2).Cells(Rows.Count, 1).End(xlUp).Row + 1
Worksheets(2).Cells(S, 1) = "合计"
Worksheets(3).Activate
Worksheets(3).Range("A:A").Value = Worksheets(1).Range("B:B").Value
t = Worksheets(3).Cells(1, 1)
Worksheets(3).Cells(1, 1) = 1 & t
S = Worksheets(3).Cells(Rows.Count, 1).End(xlUp).Row
Worksheets(3).Range(Cells(1, 1), Cells(S, 1)).Select
With ActiveSheet.Sort
With .SortFields
.Clear
.Add Key:=Range("A2"), Order:=xlDescending
End With
.Header = xlGuess
.MatchCase = False
.SortMethod = xlPinYin
.Orientation = xlSortColumns
.SetRange Rng:=Range(Cells(2, 1), Cells(S, 1))
.Apply
End With
Worksheets(3).Range("A:A").RemoveDuplicates 1
Worksheets(2).Activate
For i = 2 To Worksheets(3).Cells(Rows.Count, 1).End(xlUp).Row
Worksheets(2).Cells(1, i).Value = Worksheets(3).Cells(i, 1).Value
Worksheets(2).Cells(1, i + 1) = "合计"
Next
Worksheets(2).Range("A1").CurrentRegion.Select
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlInsideVertical)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlInsideHorizontal)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
Worksheets(2).Activate
For i = 2 To Worksheets(2).Cells(Rows.Count, 1).End(xlUp).Row
For j = 2 To Worksheets(1).Cells(Rows.Count, 1).End(xlUp).Row
If Worksheets(2).Cells(i, 1) = Worksheets(1).Cells(j, 1) Then
For k = 2 To Worksheets(2).Cells(1, Columns.Count).End(xlToLeft).Column
If Worksheets(1).Cells(j, 2) = Worksheets(2).Cells(1, k) Then
t = Worksheets(2).Cells(i, k)
Worksheets(2).Cells(i, k) = Worksheets(1).Cells(j, 3)
S = Worksheets(2).Cells(i, k)
Worksheets(2).Cells(i, k) = S + t
End If
Next
End If
Next
Next
i = Range("A1").CurrentRegion.Rows.Count
For j = 2 To Cells(1, Columns.Count).End(xlToLeft).Column
Cells(i, j) = Application.WorksheetFunction.Sum(Range(Cells(2, j), Cells(i - 1, j)).Value)
Next
i = Range("A1").CurrentRegion.Columns.Count
For j = 2 To Cells(Rows.Count, "A").End(xlUp).Row
Cells(j, i) = Application.WorksheetFunction.Sum(Range(Cells(j, 2), Cells(j, i - 1)).Value)
Next
Worksheets(2).Range("A1").CurrentRegion.Select
Selection.Rows.AutoFit
Selection.Columns.AutoFit
End Sub