一转眼，2 19年已至4月，自从年初立下flag后，便努力朝着实现它的方向奔跑。有些执行得很好，比如每天更新 Excel微信，坚持每天学习，而有些则还没有开始。是时候该督促自已全面开始了！于是，制作了一个简单的计划执行情况统计分析表，加上少量的VBA代码，以方便自已每周检视计划的执行情况，提醒自已哪些没做，要赶快补上。

下面，将创建过程与大家分享。有兴趣的朋友可以作为模板，或者与自已的实际情况相结合，稍作修改，用作自已的一个工具。

下所示为我使用的数据记录表，工作表名“个人计划执行记录”，每天晚上睡觉前或者第二天上午上班前，我会将一天的学习生活情况记录在此。

在列G中，使用了“数据验证”功能（即原来的“数据有效性”），可以直接在列表中选择分类，如下所示。

“数据验证”设置如下所示。

其中，“category”是定义的名称，代表下所示工作表“计划执行统计”的单元格区域B7:B21。

在中，单元格C4是统计的起始日期，命名为startDate；单元格D4是统计的结束日期，命名为endDate，这是我们在这个工作表中唯一要输入的两个数值。输入日期后，单击其右侧的“更新”按钮，自动统计这两个日期之间的相应数据。该按钮关联了下文所的用于实现自动统计的VBA程序。

单元格区域C7:D21是输出区域，通过VBA程序自动生成各分类上花费的时间和做的次数。

单元格区域B7:B21除作为上文介绍的分类下拉列表项来源外，还设置了条件格式，如下所示。当统计的次数不符合要求时，相应分类的字体会显示红色。

在VBA代码中，使用了高级筛选功能。工作表“个人计划执行记录”的单元格区域J1:K2是条件区域，关联了工作表“计划执行统计”中输入的起始日期（startDate）和结束日期（endDate）。从单元格M1开始，放置符合筛选条件的数据，如下所示。

代码将筛选出的数据与分类（category）比较，计算相应分类上事项所花的时间及开展的次数，并输入工作表“计划执行统计”中的单元格区域C7:D21。

完整的代码如下：

Sub planstatistics()

‘数据分析汇总工作簿变量

Dim wksStat As Worksheet

‘数据工作簿变量

Dim wksRecord As Worksheet

‘数据区域

Dim rngDatas As Range

‘筛选数据放置的区域

Dim rngFilterData As Range

‘筛选条件区域

Dim rngCriteria As Range

‘循环变量

Dim rng As Range

Dim cell As Range

‘数据区域的最后一行

Dim lngDataLastRow As Long

‘筛选的数据的最后一行

Dim lngFilterLastRow As Long

‘数据分析区域的最后一行

Dim lngLastRow As Long

‘计数变量

Dim lngCount As Long

‘设置工作簿变量

Set wksStat = Worksheets(“计划执行统计”)

Set wksRecord = Worksheets(“个人计划执行记录”)

‘设置被筛选数据所在区域

lngDataLastRow =wksRecord.Range(“A” & Rows.Count).End(xlUp).Row

Set rngDatas =wksRecord.Range(“A1:G” & lngDataLastRow)

‘初始化筛选条件和筛选值放置的区域

With wksRecord

.Range(“J2″) =”>=” & [StartDate]

.Range(“K2″) =”<=” & [EndDate]

.Range(“M1:S” &Rows.Count).Clear

Set rngCriteria =.Range(“J1:K2”)

Set rngFilterData =.Range(“M1”)

End With

‘筛选数据

rngDatas.AdvancedFilterAction:=xlFilterCopy, _

CriteriaRange:=rngCriteria, _

CopyToRange:=rngFilterData

‘获取筛选的数据

lngFilterLastRow =wksRecord.Range(“M” & Rows.Count).End(xlUp).Row

If lngFilterLastRow = 1 Then Exit Sub

‘清除统计表中已有数据

lngLastRow = wksStat.Range(“B”& Rows.Count).End(xlUp).Row

wksStat.Range(“C7:D” &lngLastRow).ClearContents

‘分析数据并将结果输入到数据分析工作簿

For Each rng In [Category]

lngCount =

For Each cell InwksRecord.Range(“S2:S” & lngFilterLastRow)

If rng = cell Then

rng.Offset( , 1) =rng.Offset( , 1) + cell.Offset( , -2)

lngCount = lngCount + 1

End If

Next cell

rng.Offset( , 2) = lngCount

Next rng

End Sub

代码中有很多“硬编码”，例如wksStat.Range(“C7:D” & lngLastRow)和wksRecord.Range(“S2:S” &lngFilterLastRow)中的单元格引用。如果工作表中的分类或列数据有增减，要作相应的修改。

代码的图片版如下：

结语：不必拘束于代码的优雅，也不必在意通用性，只要能够解决问题，快速实现自已的目的，适合自已就行，这就是VBA最大的好处。

阅读全文