Option Explicit
Function is_exists(name As String)
Dim sht As Worksheet
For Each sht In Worksheets
If sht.name = name Then
is_exists = True
Exit Function
End If
Next
is_exists = False
End Function
Sub 分組統(tǒng)計(jì)()
Dim LastRow, LastCol As Long
Dim Sh As Worksheet
'Sh指代當(dāng)前活動(dòng)頁(yè)
Set Sh = Sheets("data")
'當(dāng)前活動(dòng)頁(yè)的最后一行
LastRow = Sh.Cells(Rows.Count, 1).End(xlUp).row
'當(dāng)前活動(dòng)頁(yè)的最后一列
LastCol = Sh.Cells(1, Columns.Count).End(xlToLeft).Column
'定義D為字典
Dim D As Object
Set D = CreateObject("Scripting.Dictionary")
Dim row, i As Integer
Dim key, value As String
For i = 2 To LastRow
key = Sh.Cells(i, 3).value
value = Sh.Cells(i, 4).value
'如果在字典里
If Not D.exists(key) Then
D.Add key, Array(0, 0, 0)
End If
row = D(key)
If value = "A區(qū)" Then
row(0) = row(0) + 1
ElseIf value = "B區(qū)" Then
row(1) = row(1) + 1
ElseIf value = "C區(qū)" Then
row(2) = row(2) + 1
End If
D(key) = row
Next
'調(diào)試輸出字典存儲(chǔ)的內(nèi)容
For Each key In D.keys()
Debug.Print key & "," & Join(D(key), ",")
Next
Dim sht As Worksheet
If is_exists("result") Then
Sheets("result").Delete
End If
'在最后的位置增加一個(gè)sheet作為結(jié)果表
Sheets.Add After:=Sheets(Sheets.Count)
Set sht = Sheets(Sheets.Count)
sht.name = "result"
'屏幕刷新=false
Application.ScreenUpdating = False
'下面寫出數(shù)據(jù)到結(jié)果表中,首先寫出標(biāo)題行
sht.Range("A1").Resize(1, 4) = Application.Transpose(Array("deal_date", "A區(qū)", "B區(qū)", "C區(qū)"))
sht.Range("A2").Resize(D.Count, 1) = Application.Transpose(D.keys)
i = 2
For Each row In D.items()
sht.Cells(i, 2).Resize(1, 3) = row
i = i + 1
Next
Application.ScreenUpdating = True
End Sub