Excel-VBA入门(3): 面向对象编程/过程调用/函数/文本处理与汇总

(一)面向对象编程

如何比较多个工作表, 怎么合并多个工作簿?如何自动添加图表??

这些需要用到面向对象编程(object oriented )

面向对象就是一种程序设计方法: 

定义类(class) , 类的属性attribute( 一个人的姓名 身高 体重)

每一类能够执行什么动作? 称作方法method  : 跑步, 学习, 吃饭...

类 就是一个模具, 而对象就是 模具做出来一个个真实的东西,

例如:

p1= 人 类对象, p2=人 类对象

w1=武器 类对象, w2=武器 类对象

属性

p1.name="jack", p1.weapon=w1

p1.sex=m

方法

p1.吃饭()

p1.跑步(方向: 前)

p1.攻击(目标: p2)

excel 中图如何运用?  excel 自己已经定义很多类, 但是太多了记不住啊.. 你只需要知道常用的一个就行.  主要记住四个:

application(excel 系统)

workbook(工作簿)

worksheet(工作表)

range(单元格内容区域)

它们之间的从属关系如下:

application(excel 系统)--> workbooks--> workbook-->worksheets-->worksheet-->cells-->range

或者直接worksheet--->range

实例1: 在sheet1中制作一个按钮, 能控制sheet 3 的cells(10,1)=10

Option Explicit
Sub 改变sheet3()
    Dim w1 As Worksheet
    Set w1 = Worksheets(3) ' 第三张工作表,
    '对代表对象的变量赋值时, 必须用set
    w1.Cells(10, 1) = 10
End Sub

若想对所有的工作表都做这样的操作, 但是不知道总共多少张工作表, 怎么办?

worksheets  有一个count 属性可以获知, 

for i   =1 to  worksheets.count

如何自动添加工作表?

worksheets 的add 方法, 在所属工作簿中新建一个工作表,

worksheets.add

Sub 新建工作表()
    Worksheets.Add
End Sub

 注意不是worksheets.add()  不用加括号!!

进一步, 新建3张工作表并做修改, 让cells(1,1)=100

Sub 新建工作表()
    Dim w1 As Worksheet
    Dim i
    For i = 1 To 3
        Set w1 = Worksheets.Add
        w1.Cells(1, 1) = 100
    Next i
    
End Sub

实例2 ;汇总多张工作表,

现在有三张工作表, 分别是三个同学AA,BB,CC的各课成绩, 现在需要汇总每个同学的总分,

首先我们来看对一张工作表的情况

Sub 汇总一张()
    Dim i, s
    s = 0
    For i = 2 To 6
        s = s + Cells(i, 2)
    Next i
    Cells(1, 3) = s
    
End Sub

如何遍历3张工作表?

再套一个循环就行了

Sub 求总分()
    Dim i, r, s
    Dim w1 As Worksheet
    For r = 1 To 3
        Set w1 = Worksheets(r)
        
        s = 0
        For i = 2 To 6
            s = s + w1.Cells(i, 2)
        Next i
        w1.Cells(2, 3) = s
        
    Next r
    
End Sub

注意上述三位同学的而成绩所在工作表排在前三个

Worksheets(1) 表示排在最前面的工作表 而不是指sheet1

进一步, 如何将这三位同学的总分记录到总分表中?

Sub 汇总总分()
    Dim r, name, score
    
    Dim w1 As Worksheet, w2 As Worksheet
    Set w2 = Worksheets(4)
    For r = 1 To 3
        Set w1 = Worksheets(r)
        name = w1.Cells(1, 1)
        score = w1.Cells(2, 3)
        w2.Cells(r, 1) = name
        w2.Cells(r, 2) = score
    Next r
    
End Sub

 得到 在总分表中已经有了如下:

之前操作中 用到Worksheets(4) , 之类的, 都是不好的 ,一旦工作表位置发生了变化,程序就错了,( 所谓刻舟求剑!!)需要 用工作表的名字,  用Worksheets("总分表") 

判别是不是这个工作表, set w1=worksheets(2)

w1.name="总分表"

 下面, 如何将上述 计算总分与汇总总分合并成一个按钮??

Sub 计算与汇总()

    Dim i, r, s
    Dim w1 As Worksheet, w2 As Worksheet
    Set w2 = Worksheets("总分表")
    
    For r = 1 To 3
        Set w1 = Worksheets(r)
        s = 0
        For i = 2 To 6
            s = s + w1.Cells(i, 2)
        Next i
        w1.Cells(2, 3) = s
        w2.Cells(r, 1) = w1.Cells(1, 1) ' 写入姓名
        w2.Cells(r, 2) = s '写入总分
    Next r
End Sub

(二) 过程调用

VBA中有更省时的办法, 直接将两个代码 粘贴到一起, 不用修改, 在汇总代码中说一句话"运行我之前必须先运行计算总分的程序"

原来是两个按钮

Option Explicit
Sub 求总分()
    Dim i, r, s
    Dim w1 As Worksheet
    For r = 1 To 3
        Set w1 = Worksheets(r)
        
        s = 0
        For i = 2 To 6
            s = s + w1.Cells(i, 2)
        Next i
        w1.Cells(2, 3) = s
        
    Next r
End Sub

和

Sub 汇总总分()
    Dim r
    Dim w1 As Worksheet, w2 As Worksheet
    Set w2 = Worksheets("总分表")
    For r = 1 To 3
        Set w1 = Worksheets(r)
        w2.Cells(r, 1) = w1.Cells(1, 1)
        w2.Cells(r, 2) = w1.Cells(2, 3)
    Next r
End Sub

现在修改第二个汇总总分 按钮 只要增加一句话 call...

Sub 汇总总分()
    Dim r
    Dim w1 As Worksheet, w2 As Worksheet
    Call 求总分 ' 呼叫求总分 按钮
    Set w2 = Worksheets("总分表")
    For r = 1 To 3
        Set w1 = Worksheets(r)
        w2.Cells(r, 1) = w1.Cells(1, 1)
        w2.Cells(r, 2) = w1.Cells(2, 3)
    Next r
End Sub

这个就叫 过程调用! (类似函数调用)

调用的多了自然计算量大, 很多循环是冗余的, 但是在不影响计算速度的时候, 还是建议一个个分开来写, 这样层次清楚 ,也易于修改, 可增加按钮, 减少按钮, 如果写到一起, 每次都要仔细修改代码

Sub 计算与汇总()
    call 求总分
    call 汇总总分
End Sub

如果还有别的过程, 则再call 就行了! 这就像函数一样, 可以被其他的主程序反复调用!!

其实可以省略call , 直接写过程的名字就行

Sub 计算与汇总()
    求总分
    汇总总分
End Sub

(三)函数

函数与过程啥区别?函数可以有返回值, 函数名是啥, 返回值就是函数名

实例 成绩等级评定

 

不用函数的代码:

Option Explicit
Sub 成绩等级()
    Dim i, score, level
    i = 2
    Do While Cells(i, 1) <> ""
        score = Cells(i, 2)
        If score >= 90 Then
            level = "A"
        ElseIf score >= 80 Then
            level = "B"
        ElseIf score >= 70 Then
            level = "C"
        ElseIf score >= 60 Then
            level = "D"
        Else
            level = "F"
        End If
        Cells(i, 3) = level
        i = i + 1
    Loop
        
End Sub

利用函数

Option Explicit
Sub 成绩等级()
    Dim i, score, level
    i = 2
    Do While Cells(i, 1) <> ""
        score = Cells(i, 2)
        level = 等级(score)
        Cells(i, 3) = level
        i = i + 1
    Loop
        
End Sub

Function 等级(s)
    Dim score, level
    score = s
        If score >= 90 Then
            level = "A"
        ElseIf score >= 80 Then
            level = "B"
        ElseIf score >= 70 Then
            level = "C"
        ElseIf score >= 60 Then
            level = "D"
        Else
            level = "F"
        End If
            
    等级 = level
End Function

注意: 函数需要引入一个参数s, 函数定义中 返回值要调用函数名 : 等级 = level

excel更加厉害的是, 函数 "等级" 可以作为自定义函数直接在单元格中实现,还可以拖动填充!! 逆天啦!!

         

注意: 但是这个公式只能在这个工作簿中使用, 打开另一个excel 就不行了.

 (四) 字符串的处理函数

VBA中内置了很多编写好的函数, 可调用

例如 sqr(a) 

下面介绍处理文本的函数, 这里不打算用按钮的形式, 而是利用VBA 编辑器中的运行按钮(绿色三角形) 然后结果不显示在单元格中, 用一个对话框 来显示结果, 先来看个最简单的例子

msgbox a

编写好后 点击运行 就出现了这个对话框!

1. len(s)  字符串长度 

 

2. trim(s)  它可以去掉字符串两边的空格

注意: trim 函数并没有修改原来的a 

啥用? 用于比较excel 中的文本是否相等, 如果有时两端有空格, 会不相等, 因此trim 很重要

但是trim 不会删除中间的空格

3. replace(s,a,b) 将s 中的所有a 替换成b 

例如将所有空格变成逗号 

4. lcase(s) 英文字母变成小写; ucase(s) 变成大写, 非英文字母不变  (lower upper)

啥用, 也是用于比较"Alice"<>"alice" 但是 转化后就相等了!

5. left(s,a) 从s的左边取出a个字符, 同理还有right(s,a) ,

mid(s,i,a) 从s 的第i 个字符开始, 取出a个字符返回

啥用??,  比如提取浙江省的学生, 那么在地址中识别前三个字符是不是"浙江省"

 6. instr(s,a)  在s 中寻找a , 若找到则返回a 的位置(若出现多个a, 则返回第一个a 的位置),没有找到返回0

 

如果a 出现多次, 但是想要非 第一个出现的 位置 怎么办?

instr(i,s,"葡萄") : 在s的第i个位置开始寻找a

应用:  宁波路55号301室,  如何依次取出 路名,门牌号,室号??

Option Explicit
Sub 地址区分()
    Dim s, i, 路字, 号字, 室字
    For i = 2 To 5
        s = Cells(i, 1)
        路字 = InStr(s, "路")
        号字 = InStr(s, "号")
        室字 = InStr(s, "室")
        Cells(i, 2) = Left(s, 路字)
        Cells(i, 3) = Mid(s, 路字 + 1, 号字 - 路字)
        Cells(i, 4) = Right(s, Len(s) - 号字)
    Next i
End Sub

如果路名中含有 号这个字 会出错,那么就在搜索号字的时候, instr(路字,s,"号")

对字符串的处理 还有更加高大上的  正则表达式 , 以后再说...

应用2: 1月 2月 3月 汇总成一张一季度报表, 一个工作簿中有很多工作表, 如何只处理 1月 2月 3月 这3张表, 我们发现这三张表的名字都很特殊, 结尾都是"月" , 下面是1月的表, 想要将三张表加总成一张季度表

     

程序思想: 遍历所有工作表, 找到名字末尾是 "月"的 表进行加总

Sub 季度汇总()
    Dim i, k
    Dim w As Worksheet, r As Worksheet
    Set r = Worksheets("一季度汇总")
    For i = 1 To Worksheets.Count
        Set w = Worksheets(i)
        If Right(w.name, 1) = "月" Then ' 最后字符是否为月
            For k = 2 To 5
                r.Cells(k, 2) = r.Cells(k, 2) + w.Cells(k, 2)
                r.Cells(k, 3) = r.Cells(k, 3) + w.Cells(k, 3)
                r.Cells(k, 4) = r.Cells(k, 4) + w.Cells(k, 4)
            Next k
        End If
    Next i
    
End Sub

得到

上述可以改进的地方,  在循环扫描每一个工作表时, 用到了变量i,

    For i = 1 To Worksheets.Count

   Set w = Worksheets(i)

其实这里的 i 没有别的用处, 因此可以用另一种循环代替 

for each a in b 

next a

改进得到简洁的代码 ,省去变量i

Sub 季度汇总()
    Dim k
    Dim w As Worksheet, r As Worksheet
    Set r = Worksheets("一季度汇总")
    For Each w In Worksheets '修改
        If Right(w.name, 1) = "月" Then ' 最后字符是否为月
            For k = 2 To 5
                r.Cells(k, 2) = r.Cells(k, 2) + w.Cells(k, 2)
                r.Cells(k, 3) = r.Cells(k, 3) + w.Cells(k, 3)
                r.Cells(k, 4) = r.Cells(k, 4) + w.Cells(k, 4)
            Next k
        End If
    Next w ' 修改
    
End Sub

总结

如果每一张工作表的长度不一样, 姓名顺序也不同怎么办?

思路: 遍历一季度汇总表的名字, 比如mike, 在3张月报表中找"Mike",

Sub 季度汇总()
    Dim i, k, name
    Dim w As Worksheet, r As Worksheet
    Set r = Worksheets("一季度汇总")
    For i = 2 To 5 ' 遍历汇总表中的所有名字
        name = r.Cells(i, 1)
        For Each w In Worksheets
            If Right(w.name, 1) = "月" Then ' 最后字符是否为月
                k = 2
                Do While w.Cells(k, 1) <> "" ' 不知道月报表长度多少, 用while
                    If LCase(Trim(w.Cells(k, 1))) = LCase(Trim(name)) Then
                        r.Cells(i, 2) = r.Cells(i, 2) + w.Cells(k, 2)
                        r.Cells(i, 3) = r.Cells(i, 3) + w.Cells(k, 3)
                        r.Cells(i, 4) = r.Cells(i, 4) + w.Cells(k, 4)
                    End If
                k = k + 1
                Loop
            End If
        Next w
    Next i
End Sub