我的第一个VBA

记录我的第一个VBA

背景

之前看过同事使用excel宏做预算，一直很羡慕！很多年后，为了提高自己的工作效率，自学vba，现记录我的第一vba作品。

目录

1. 需求
2. 工作思路
3. 上图
4. 上代码（代码中有注释，不解释）

需求

某公司的审批流程（已做过处理，简化）需要我统计所有审批流程中节点是董事长的流程。

工作思路

1. 观察数据结构,每个审批节点都是通过“→”链接的（暂考虑数据格式正常的情况）
2. 在excel中通过“→”来分列
3. 通过vba提取出含有董事长的一整行数据
4. 生成新的数据

上图

（其实后来想想,这个步骤也可以代码实现）


结果如下（序号没有处理）

上代码

Sub findByCode2()
    '定义一个workSheet,名称是sheetJava
    Dim sheetJava As Worksheet
    '设置sheetJava指向sheet名称为"Sheet2"的工作表
    Set sheetJava = Worksheets(Sheet2)
    '定义两个整数变量,用来存储数据所在最大行数和最大列数
    Dim maxRowNum, maxColumnsNum As Integer
    '赋值
    maxRowNum = sheetJava.UsedRange.Rows.Count
    maxColumnsNum = sheetJava.UsedRange.Columns.Count
    '定义三个整数用于循环使用
    Dim J, K, L As Integer
    '定义一个状态,用于判断是否保存excel行号(通过判断该行有董事长该状态为true,没有董事长为false)
    '如果为true会通过下面的arr数组保存该行的行数,false就不保存
    Dim B As Boolean
    '设置默认值(但是这步好像多余了)
    B = False
    '定义一个数组用来存储含有董事长所在的行号
    Dim arr(5000) As Integer
    '定义一个整数,用来增加数组的索引(刚学,没有查到往数组添加元素的方法,所以用笨方法做)
    Dim num As Integer
    num = 0
    '激活Sheet2
    sheetJava.Activate
    '定义一个字符串变量,用来接收董事长
    Dim str As String
    '获取E1单元格的值,并赋值给str
    str = Range("E1").Formula
    '定义一个字符串变量,用来接收工作表sheet的名称
    Dim strName As String
    '获取E2单元格的值,并赋值给strName
    strName = Range("E2").Formula
    
    '根据我的表格设计情况我应该从第5行,开始循环,一直到最大的行数
    '一行一行的循环,判断哪一行含有董事长(str)
    '列的话从第2列开始循环,一直到最大的列数
    '过程是先判断第5行第2个单元格内容是不是董事长,
    '如果是B就变成True,并且将该行号保存在arr数组中,然后跳出循环查找第6行
    '如果不是直接查找下一行,
    '知道所以数据走一遍
    For J = 5 To maxRowNum '循环行
        For K = 2 To maxColumnsNum '循环列
            B = False '状态变为默认状态
            If sheetJava.Cells(J, K).Value = str Then '判断单元格内容是不是董事长
            B = True '是董事长,B改为true
            Exit For '跳出循环
            End If '结束判断
        Next
        If B = True Then '如果B是true的情况下
        arr(num) = J '将行号保存在arr数组中
        num = num + 1 '数组索引加1
        End If
    Next
    '定义一个新的workSheet,名称是sheetJavaNew
    Dim sheetJavaNew As Worksheet
    '代码创建新的workSheet
    Set sheetJavaNew = Worksheets.Add
    '修改sheet名称
    sheetJavaNew.Name = strName
    '死代码,设置表头
    '第一行添加表头
    sheetJavaNew.Range("A1").Value = "序号"
    sheetJavaNew.Range("B1").Value = "审核1"
    sheetJavaNew.Range("C1").Value = "审核2"
    sheetJavaNew.Range("D1").Value = "审核3"
    sheetJavaNew.Range("E1").Value = "审核4"
    sheetJavaNew.Range("F1").Value = "审核5"
    sheetJavaNew.Range("G1").Value = "审核6"
    sheetJavaNew.Range("H1").Value = "审核7"   
    '通过arr中存储的行号,将数据复制到新sheet中
    For L = 0 To num - 1
        sheetJava.Rows(arr(L)).Copy sheetJavaNew.Rows(arr(L))
        maxh = Worksheets("Sheet2").Range("a65536").End(3).Row
        Range("a1:a" & maxh).SpecialCells(xlCellTypeBlanks).Select
        Selection.EntireRow.Delete
    Next
End Sub

说明

代码本人亲测，绝对拿来就能免费使用。希望以后我能用excel操作ppt，这样我的一个汇总周报的工作就方便了！