【vba】Excel vba实现工作量匹配

  

一、背景

我今天对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