VBA自学日志

---

前言

VBA自学成柴第四周

一、Find

用于在区域内查找特定信息，如果找到了返回一个range对象，它代表在其中找到该信息的第一个单元格，如果没找到，返回nothing。

• 格式

Range.Find(What,After,LookIn,LookAt,SearchOrder,SearchDirection, _
MatchCase,MatchBytem,SearchFormat)

• 部分参数说明

Find 参数
What	需要查找的值
After	在什么之后开始查询
LookIn(xlformulas)	查询公式
LookIn(xlvalues)	查询值
LookIn(xlcomments)	查询批注
LookAt(xlWhole)	精确查询 简写1
LookAt(xlPart)	模糊查询 简写2
SearchOrder(xlByRows)	按行查找 简写1
SearchOrder(xlByColumns)	按列查找 简写2
SearchDirection(xlnext)	向下查找 简写1
SearchDirection(xlprevious)	向上查找 简写2
MatchCase	是否区分大小写，True区分，False为默认值不区分

---

查找李一所在的地址

Msgbox Range("A:A").Find("李一").Address(0,0)
'Address(0,0)代表消除锁定

在a6单元格后查找李一所在的位置

Msgbox Range("A:A").Find("李一",Range("A6")).Address(0,0)

查找公式中有20的单元格

MsgBox Range("A:A").Find(20,,xlformulas).Address(0,0)

查找值为20的单元格

MsgBox Range("A:A").Find(20,,xlvalues).Address(0,0)

查找批注是20的单元格

MsgBox Range("A:A").Find(20,,xlcomments).Address(0,0)

查找姓李的同学，精确查询

MsgBox Range("A:A").Find("*李*",,xlvalues,1).Address(0,0)

查找姓李的同学，模糊查询

MsgBox Range("A:A").Find("李",,xlvalues,2).Address(0,0)

查找李一，向下查询

MsgBox Range("A:A").Find("李一",,xlvalues,,,1).Address(0,0)

查找李一，向上查询

MsgBox Range("A:A").Find("李一",,xlvalues,,,2).Address(0,0)

• 案例，将所有同学随机分配成3个人 一个小组
  

Sub 随机抽取()
Dim a%, b%, c%, d%
'找到所需要抽取的人数
a = Cells(Rows.Count, "b").End(xlUp).Row
'对于结果列计数
d = Application.WorksheetFunction.CountA([i:i])
'如果总人数减去生成的人数小于3，就表示人数不够了，无法
'再进行循环，如果继续循环会进入死循环，所以提前结束。
If a - d < 3 Then MsgBox "人数不够了": Exit Sub
Do
'随机生成2到a的序列
b = Int((a - 2 + 1) * Rnd + 2)
'定位到结果列的行数
c = Cells(Rows.Count, "i").End(xlUp).Offset(1, 0).Row
'如果结果列中没有找到，就复制到结果列中，并且如果c不等2，x=0的话，
'空一个格生成
If Range("i:i").Find(Cells(b, "b")) Is Nothing Then
    If c <> 2 And x = 0 Then c = c + 1
    Cells(b, "b").Copy Cells(c, "i")
    x = x + 1
End If
Loop Until x = 3
End Sub

二、FindNext

首先查找了李一，然后现在查找下一个李一，就用FindNext

• 格式

set b = range(“区域”).Find(“xxx”)
Set a = range(“区域”).FindNext(b)

例子：查找所有一年级的学生

Sub 查找下一行()
Dim a%, b, d As String, c As Range
'定位查询表的函数
a = Cells(Rows.Count, "a").End(xlUp).Row
'定位第一个一年级的地址
Set c = Range(Cells(2, "a"), Cells(a, "a")).Find("一年级")
b = c.Address
'每次点击运行都会清除上次的运行结果
[e2:g50].Clear
'开始循环，直到最后一个地址等于第一个地址
'代表循环结束，查找到所有一年级的学生
Do
'不断叠加，寻找下一个，利用resize重组数据，得到全部数据
'复制到结果表中
Set c = Range(Cells(2, "a"), Cells(a, "a")).FindNext(c)
c.Resize(1, 3).Copy Cells(Rows.Count, "e").End(xlUp).Offset(1, 0)
d = c.Address
Loop Until d = b
End Sub

---

三、筛选

顾名思义筛选你想要的值

• 格式

AutoFilter(Field,Criteria1,Operator,Criteria2,SubField,VisibleDropDown)

• 部分参数说明

参数名	作用
Field	筛选哪列，最左列为第一列
Criteria1	条件1
Operator	指定筛选的类型
Operator(xland)	criteria1和criteria2并且关系
Operator(xlor)	criteria1和criteria2或者关系
Operator(xlTop10Items)	显示最大值的项，在criteria1中指定
Operator(xlBottom10Items)	显示最小的项，在criteria1中指定项目
Operator(xlTopPercent)	显示最大值的项，在criteria1中指定百分比（前10%，填10）
Operator(xlBottom10Percent)	显示最小值的项，在criteria1中指定百分比
Operator(xlFilterValues)	筛选值
Operator(xlFilterCellColor)	单元格颜色
Operator(xlFilterFontColor)	字体颜色
Operator(xlFilterIcon)	筛选图标
xlFilterDynamic	动态筛选

• 一些动态筛选的参数（官网）：
  https://learn.microsoft.com/zh-cn/office/vba/api/excel.xldynamicfiltercriteria

筛选一年级的同学

Set a = Range("a1").CurrentRegion
a.AutoFilter 1, "一年级"

筛选一年级并且成绩大于80分以上的同学

a.AutoFilter 1, "一年级": a.AutoFilter 3, ">=80"

显示成绩排名前5的同学

a.AutoFilter 3 , 5 , xlTop10Items

显示一年级，二年级的同学

a.AutoFilter 1,Array("一年级"，"二年级")

• RGB的计算方法

Sub 计算颜色()
A=range(“a1”).Interior.Color
Red = a mod 256
Green = y \ 256 Mod 256
Blue = y \ 256 ^ 2 Mod 256 
MsgBox  “red” & ”,” & “green” & “,” & “blue”
End Sub

• 案例 拆分工作簿，按照年级拆分到新的工作簿中，新工作簿以各年级命名
  

Sub 拆分工作簿()
Dim a%, c%, d%, b As Workbook, e As Range
'首先构建辅助列
c = Cells(Rows.Count, "a").End(xlUp).Row
Range(Cells(2, "a"), Cells(c, "a")).Copy [e:e]
'利用辅助列计算到底需要新增多少个表
Range("e:e").RemoveDuplicates 1, xlNo
'计算需要循环的次数
d = Application.WorksheetFunction.CountA([e:e])
Do
x = x + 1
'在数据里面查找满足辅助列条件的值
Range("a1").AutoFilter 1, Cells(x, "e")
'将所有筛选值保存在e中
Set e = Range("a1").CurrentRegion
'新增工作表b
Set b = Workbooks.Add
'将筛选值复制到新工作表的a1单元格
e.Copy b.Sheets(1).[a1]
'将结果保存到当前文件路径，并以新工作表的a2单元格命名
b.SaveAs ThisWorkbook.Path & "\" & b.Sheets(1).[a2]
'关闭保存的单元格
b.Close
Loop Until x = d
'删除辅助列
[e:e].Delete
'恢复到数据表原先的样子
Sheets(1).AutoFilterMode = False
End Sub

---

四、Union并集

就是Excel同时选择多个单元格

• 格式

union (单元格)

• 案例
  

将成绩大于80分的同学粘贴到e1单元格

Sub 并集()
Dim a%, b, result As Range
a = Cells(Rows.Count, "a").End(xlUp).Row
For Each b In Range(Cells(2, "c"), Cells(a, "c"))
    If b.Value > 80 Then
        '由于union第一个必须有初始值，所以如果没有值的话，就将大于80的第一个值
        '赋予给result，然后不断合并。
        If result Is Nothing Then Set result = b.Offset(0, -2).Resize(1, 3)
            Set result = Union(result, b.Offset(0, -2).Resize(1, 3))
    End If
Next b
'这里写在循环外面，是因为如果写在里面它会输出并集的结果
'每次并集都有结果，写在外面才是总结果
result.Copy Cells(Rows.Count, "e").End(xlUp)
End Sub

---

五、intersect交集

顾名思义，两个地方所交汇的地方

• 格式

intersect(range1,range2)

• 成绩大于80分同学的平均值
  

Sub 交集()
Dim a%, b, result As Range
a = Cells(Rows.Count, "a").End(xlUp).Row
For Each b In Range(Cells(2, "c"), Cells(a, "c"))
    If b.Value > 80 Then
        '由于union第一个必须有初始值，所以如果没有值的话，就将大于80的第一个值
        '赋予给result，然后不断合并。
        If result Is Nothing Then Set result = b.Offset(0, -2).Resize(1, 3)
            Set result = Union(result, b.Offset(0, -2).Resize(1, 3))
    End If
Next b
'通过intersect计算result和c列的交集，
'得到大于80的同学的成绩
'然后利用excel里面的函数计算平均值
MsgBox Application.WorksheetFunction.Average(Intersect(result, [c:c]))
End Sub

---