VBA自学日志
文章目录
- 前言
- 一、Find
- 二、FindNext
- 三、筛选
- 四、Union并集
- 五、intersect交集
前言
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