当前位置：首页 > news >正文

VBA使用字典统计

news 来源：原创 2025/6/15 9:17:44

Sub statistical_data()
Dim lastRow As Long '每个sheet的最后一行
Dim i As Long, j As Long
Dim ws As Worksheet

'按照任务紧急程度_紧急重要,重要不紧急，紧急不重要，不紧急不重要作为key统计计划用时，和时间用时
Dim emergency_dict As Object
Set emergency_dict = CreateObject("Scripting.Dictionary")
'按照任务分类平台作为KEY,统计统计计划用时，和时间用时
Dim task_dict As Object
Set task_dict = CreateObject("Scripting.Dictionary")


'定义要存储的数组 0存放计划用时，1存放实际用时
Dim time_date(0 To 1) As Single
Dim emergency_key As String, type_key As String
Dim key As Variant
'Dim col_max As Integer, countcol As Integer


' 设置目标工作表和列
Set ws = ThisWorkbook.ActiveSheet ' 修改为你的工作表名称


Dim nums_of_columns As Long
Dim row_max As Long, start_row As Long

'最大的列
nums_of_columns = ws.UsedRange.Columns.Count + 1
row_max = ws.Range("D65535").End(xlUp).Row

For i = 1 To row_max
If ws.Range("D" & i) = "紧急程度" Then
start_row = i + 1
Exit For
End If
Next

Dim task_countrow As Long, emergency_countrow As Long, emergency_start_row As Long, task_start_row As Long
Dim emergency_end_row As Long, task_end_row As Long

emergency_countrow = start_row + 1
emergency_start_row = start_row + 1
task_countrow = start_row + 7
task_start_row = start_row + 7

Dim plan_col As Long, actual_col As Long, result_col As Long, emergency_col As Long, type_col As Long
For j = 2 To nums_of_columns
If ws.Cells(start_row - 1, j) = "紧急程度" Then
emergency_col = j
End If

If ws.Cells(start_row - 1, j) = "分类" Then
type_col = j
End If

If ws.Cells(start_row - 1, j) = "计划投入时间（小时）" Then
plan_col = j
End If


If ws.Cells(start_row - 1, j) = "实际投入时间（小时）" Then
actual_col = j
End If

'按照紧急程度统计,写入数据的列
If ws.Cells(start_row - 1, j) = "按照紧急程度统计" Then
result_col = j
Exit For
End If
Next

Dim result_str_start As String, result_str_end As String, chart_end_col As String
result_str_start = CNtoW(result_col)
result_str_end = CNtoW(result_col + 3)
chart_end_col = CNtoW(result_col + 2)




Dim tempArray(0 To 1) As Single
Application.ScreenUpdating = False
'进行统计分析
Dim emergency_string As String, type_string As String
Dim plan_time As Single, actual_time As Single
For i = start_row To row_max
' 在这里处理每一行的数据
emergency_string = ws.Cells(i, emergency_col)
type_string = ws.Cells(i, type_col)
plan_time = CSng(ws.Cells(i, plan_col))
actual_time = CSng(ws.Cells(i, actual_col))

emergency_key = emergency_string
type_key = type_string

'查找emergency_dict字典是否存在
If emergency_dict.Exists(emergency_key) Then
'存在原来数据读出进行累加
tempArray(0) = emergency_dict(emergency_key)(0) + plan_time
tempArray(1) = emergency_dict(emergency_key)(1) + actual_time
emergency_dict(emergency_key) = tempArray
Else
'不存在进行初始化
time_date(0) = plan_time
time_date(1) = actual_time
emergency_dict.Add emergency_key, time_date
End If

'查找task_dict字典是否存在
If task_dict.Exists(type_key) Then
'存在原来数据读出进行累加
tempArray(0) = task_dict(type_key)(0) + plan_time
tempArray(1) = task_dict(type_key)(1) + actual_time
task_dict(type_key) = tempArray
Else
'不存在进行初始化
time_date(0) = plan_time
time_date(1) = actual_time
task_dict.Add type_key, time_date
End If


Next


'清除历史残留,按照紧急程度的统计
ws.Select
Range(result_str_start & emergency_countrow & ":" & result_str_end & emergency_countrow + 3).Select
Selection.ClearContents

Dim task_row_max As Long
'清除历史残留,按照任务统计
task_row_max = ws.Range(result_str_start & 65535).End(xlUp).Row

If task_row_max > task_countrow Then
Dim startCell As String, endCell As String
startCell = result_str_start & task_countrow
endCell = result_str_end & (task_countrow + 3)

' 直接清除内容，避免使用Select/Selection
ws.Range(startCell & ":" & endCell).ClearContents
End If

' 删除工作表中的图表对象（嵌入式图表）
For Each chartObj In ws.ChartObjects
chartObj.Delete
Next chartObj



'数据写入
Dim total_plan_times As Single, total_actual_times As Single
total_plan_times = 0#
total_actual_times = 0#
For Each key In emergency_dict.Keys
ws.Cells(emergency_countrow, result_col) = key
total_plan_times = total_plan_times + emergency_dict(key)(0)
ws.Cells(emergency_countrow, result_col + 1) = emergency_dict(key)(0)
total_actual_times = total_actual_times + emergency_dict(key)(1)
ws.Cells(emergency_countrow, result_col + 2) = emergency_dict(key)(1)
ws.Cells(emergency_countrow, result_col + 3) = emergency_dict(key)(1) - emergency_dict(key)(0)
emergency_countrow = emergency_countrow + 1
Next key
ws.Cells(start_row - 1, result_col + 1) = total_plan_times
ws.Cells(start_row - 1, result_col + 2) = total_actual_times
emergency_end_row = emergency_countrow - 1



totalrow = start_row + 5
For Each key In task_dict.Keys
ws.Cells(task_countrow, result_col) = key
ws.Cells(task_countrow, result_col + 1) = task_dict(key)(0)
ws.Cells(task_countrow, result_col + 2) = task_dict(key)(1)
ws.Cells(task_countrow, result_col + 3) = task_dict(key)(1) - task_dict(key)(0)
task_countrow = task_countrow + 1
Next key
ws.Cells(totalrow, result_col + 1) = total_plan_times
ws.Cells(totalrow, result_col + 2) = total_actual_times
task_end_row = task_countrow - 1


'画二维饼图
Dim startDate As Date
Dim emergency_chart_title As String, task_chart_title As String
startDate = ThisWorkbook.ActiveSheet.Cells(1, 5).Value
emergency_chart_title = "按照紧急程度统计时间使用情况" & FormatDateToNumeric(startDate)
task_chart_title = "按照任务分类统计时间使用情况" & FormatDateToNumeric(startDate)
'按照紧急程度统计时间图表
'CreatePieChartWithCategoryLabels(start_col As String, end_col As String, start_row As Long, end_row As Long, chart_title As String)
CreatePieChartWithCategoryLabels result_str_start, chart_end_col, emergency_start_row, emergency_end_row, emergency_chart_title
CreatePieChartWithCategoryLabels result_str_start, chart_end_col, task_start_row, task_end_row, task_chart_title
Application.ScreenUpdating = True

MsgBox "The statistical time is completed."