一、背景
我今天对VBA进行了研究,把每个月的工作量核对问题解决了。
本附件执行方式(示例):
1、快捷键:Ctrl + m 或
2、鼠标左键单击按钮即可
二、思路
1、通过设置项目经理集,循环遍历项目经理集
2、通过项目经理查找出对应的pcw
3、通过pcw查找所有pcw(包括分摊项目)所在的位置
4、通过所有pcw(包括分摊项目)所在的位置获取该列所有工作量数据,如果工作量大于0,整行、整列全部填充背景色为红色。
三、操作
第一步:打开工作簿,另存为类型“启用宏的工作簿(*.xlsm)”【正常的Excel特别是2007以上版本,拓展名为.xlsx,这种拓展名有安全校验,不支持宏代码,所以这一步是必须的】
第二步:重新打开 第一步 中另存的的文件(拓展名为*.xlsm),打开代码窗口快捷键Alt+F11,将如下代码复制粘贴进去即可,根据实际情况调整下列代码中红色的代码即可【 arr1 = Array("", "吴泽航", "")】
第三步:执行,执行有多种方式,这里就先介绍三种方式
1、直接执行:打开宏(快捷键Alt+F8),点击执行即可。
2、通过快捷键执行,首先设置快捷键(Alt+F8打开宏 -选项 - 快捷键),设置确认后返回工作表按下快捷键即可。
3、在打开窗口中执行(代码窗口通过Alt+F11)
4、通过设置按钮,点击按钮执行(具体方法感兴趣的可以研究)
四、源代码如下
Option Explicit
Sub 根据项目匹配工作量及人员()
'1、通过设置项目经理集,循环遍历项目经理集
'2、通过项目经理查找出对应的pcw
'3、通过pcw查找所有pcw(包括分摊项目)所在的位置
'4、通过所有pcw(包括分摊项目)所在的位置获取该列所有工作量数据,如果工作量大于0,整行、整列全部填充背景色为红色。
'注意:1.归属于本地项目,由于工作量没有如实填报没匹配出来,本次不做研究,这种场景用vlookup解决即可
Dim i As Integer '工作表中非空单元格有多少行
Dim j As Integer '工作表共非空单元格有多少列
i = Application.WorksheetFunction.CountA(Range("1:1")) '统计第1行有多少个非空列
j = Application.WorksheetFunction.CountA(Range("A:A")) '统计A列有多少个非空行
Dim arr1 As Variant '定义项目经理集
arr1 = Array("张广奇", "吴泽航", "潘相东")
Dim m As Integer '项目经理index
Dim n As Integer '列index
Dim pcw As String '财务编号pcw
Dim Rng As Range '单元格
Dim pos As Variant '单元格位置
Dim brr As Variant '单元格位置行列数组
Dim col As Variant '单元格中列的值
Dim x As Integer '遍历行时For循环的循环变量,从5开始
Dim result As String '目标(工作量大于0)单元格中的值
Dim tmpcell As String '目标(工作量大于0)单元格
Dim tmpj As Integer '临时变量,表示行数,用于调试
tmpj = j
Dim rowpos As String
Dim colpos As String
Dim r
For m = 0 To UBound(arr1) Step 1
For n = 5 To tmpj Step 1 '全表中的列,排除前5列,前5列非目标数据,减少循环次数
If ActiveSheet.Range(Cells(3, n + 1).Address) = arr1(m) And arr1(m) <> "" Then '工作表中的第三行值中有跟项目经理数组arr1匹配且非空的,则满足条件
pcw = ActiveSheet.Range(Cells(2, n + 1).Address) '获取数组arr1中项目经理数下的pcw
For Each r In Range("2:2")
If r.Value = pcw Then
pos = r.Address
brr = Split(pos, "$")
col = brr(1)
For x = 6 To tmpj Step 1
tmpcell = col & x
result = Range(tmpcell)
rowpos = x & ":" & x
colpos = col & ":" & col
If result <> "" And Range(rowpos).Interior.Color <> 255 Then '标记过红色填充色的不再处理
Range(rowpos).Interior.Color = 255 '行标记为红色
Range(colpos).Interior.ColorIndex = 3 '列标记为红色
End If
Next
End If
Next
End If
Next
Next
MsgBox " 处理结束!"
End Sub