视频地址:https://www.bilibili.com/video/BV1gr4y137WY?p=2&vd_source=e90914683379d45ef4287d44b4e7363a
视频作者:老吴
前提准备:
image.png
变量:
image.png
变量数据类型:
image.png
对象:
image.png
对象的表达方法:
image.png
属性:
image.png
方法:
image.png
IF语句:
image.png
image.png
Sub test()
Dim n1%, n2%
n1 = 1
n2 = 3
If n1 < n2 Then
MsgBox "n1小于n2"
End If
End Sub
image.png
Sub test()
Dim n As Byte
n = InputBox("请输入成绩")
If n > 60 And n < 100 Then
MsgBox "成绩合格"
ElseIf n < 60 And n > 0 Then
MsgBox "成绩不合格"
End If
End Sub
image.png
Sub test()
If Cells(1, 1) > 150 Then
Cells(1, 2) = "高级"
ElseIf Cells(1, 1) > 100 Then
Cells(1, 2) = "中级"
Else
Cells(1, 2) = "低级"
End If
End Sub
FOR循环:
image.png
image.png
END获取数据边界:
image.png
image.png
Sub test()
MsgBox Range("a1").End(xlDown).Row
MsgBox Range("a1").End(xlToRight).Column
End Sub
ROW和ROWS的区别:
image.png
Sub test()
MsgBox Rows.Count
MsgBox Columns.Count
End Sub
image.png
usedrange:
image.png
image.png
Sub test()
MsgBox ActiveSheet.UsedRange.Rows.Count
MsgBox ActiveSheet.UsedRange.Columns.Count
End Sub
currentregion:
image.png
image.png
Sub test()
Dim rowsCount%, columnsCount%, i%, j%
rowsCount = Range("a1").CurrentRegion.Rows.Count
columnsCount = Range("a1").CurrentRegion.columns.Count
For i = 1 To rowsCount
For j = 2 To columnsCount Step 2
If Cells(i, j) < 60 Then
Cells(i, j).Interior.ColorIndex = 3
End If
Next
Next
End Sub
image.png
image.png
Sub test()
Dim ws As Worksheet, i%
For Each ws In Worksheets
i = i + 1
ws.Name = i
Next
End Sub
image.png
image.png
image.png
Sub test()
Range("a2").Resize(2, 3).Select
End Sub
image.png
Sub test()
Dim allRangeB As Range, rng As Range
Set allRangeB = Range("b1", Range("b1").End(xlDown))
For Each rng In allRangeB
If rng > 60 Then
rng.Offset(0, -1).Resize(1, 4).Interior.ColorIndex = 3
End If
Next
End Sub
image.png
image.png
Sub test()
Dim rngs As Range, tempRange As Range, locationRange As Range, copyRange As Range
Set rngs = Range("b1", Range("b1").End(xlDown))
For Each tempRange In rngs
If tempRange.Value = "牛肉" Then
n = n + 1
If n <= 3 Then
Set locationRange = Cells(Rows.Count, "d").End(xlUp).Offset(1, 0)
Set copyRange = tempRange.Offset(0, -1).Resize(1, 2)
copyRange.Copy locationRange
Else
Exit For
End If
End If
Next
End Sub
image.png
image.png
Sub test()
Dim answer%
Do
answer = InputBox("please write down the right answer")
If answer = 7 Then
MsgBox "the answer is wrong"
Else
MsgBox "the answer is right"
End If
Loop
End Sub
image.png
image.png
image.png
Sub test()
Dim answer As Date
On Error Resume Next
Do
answer = InputBox("please write down the right answer")
If Err.Number <> 0 Then
GoTo 100
End If
If answer = [a1] Then
MsgBox "the answer is right"
GoTo 101
Else
MsgBox "the answer is wrong"
End If
100:
Err.Clear
Loop
101:
Range("b1") = "jump out"
End Sub
image.png
image.png
Sub test()
Dim countNum As Byte, rowsCount As Byte
rowsCount = Cells(Rows.Count, 1).End(xlUp).Row
Do While countNum <> 3
n = n + 1
If n > rowsCount Then
countNum = 3
End If
If Cells(n, "b") = 100 Then
Cells(n, "b").Interior.ColorIndex = 3
countNum = countNum + 1
End If
Loop
End Sub
image.png
Sub test()
Dim countNum As Byte, rowsCount As Byte
rowsCount = Cells(Rows.Count, 1).End(xlUp).Row
Do Until countNum = 3
n = n + 1
If n > rowsCount Then
countNum = 3
End If
If Cells(n, "b") = 100 Then
Cells(n, "b").Interior.ColorIndex = 3
countNum = countNum + 1
End If
Loop
End Sub
vba使用工作表函数:
image.png
Sub test()
[d2] = Application.WorksheetFunction.AverageIf([b:b], "nv", [c:c])
[d1] = WorksheetFunction.CountIfs([b:b], "nv", [c:c], ">60")
End Sub
vba随机函数:
image.png
排序:
image.png
image.png
Sub test()
Dim cr As Range
Set cr = Range("a1").currentRegion
cr.Sort Range("b1"), xlAscending, Range("c1"), , xlDescending, Header:=xlYes
End Sub
find查询:
image.png
image.png
image.png
Sub test()
[d1] = Range("a:a").Find("tianqi", , xlValues, xlWhole, , xlNext).Address(0, 0)
End Sub
findnext查询:
image.png
image.png
Sub test()
Dim rng As Range
Set rng = Range("a:A").Find("zhangsan")
MsgBox Range("a:A").FindNext(rng).Row
End Sub
筛选:
image.png
image.png
Sub test()
Range("a1").AutoFilter 2, ">2", xlAnd, "<800"
End Sub
拆分工作簿:
image.png
Sub test()
Dim wb As Workbook, w1 As Workbook
Set w1 = ThisWorkbook
Set wb = Workbooks.Add
w1.Sheets(1).Range("a1:a9").Copy wb.Sheets(1).Range("a1")
wb.SaveAs ThisWorkbook.Path & "/" & "123.xls"
End Sub
UNION并集:
image.png
Sub test()
Dim rng As Range
Set rng = Union(Range("a2"), Range("c2"))
rng.Select
End Sub
交集:
image.png
image.png
Sub test()
Dim rng As Range
Set rng = Intersect(Range("a1").Resize(4, 4), Range("b1").Resize(7, 2))
rng.Select
End Sub
定位:
image.png
image.png
image.png
Sub test()
Dim rng As Range, ss As Range
Set rng = Range("a1").CurrentRegion.SpecialCells(xlCellTypeBlanks)
For Each ss In rng
ss.Value = "test value"
Next
End Sub
AutoFill自动填充:
image.png
image.png
image.png
Sub test()
Range("e2").AutoFill Range("e2:e8")
End Sub
replace替换:
image.png
image.png
Sub test()
Range("a1").CurrentRegion.Replace what:="test value", replacement:="new valuesss "
End Sub
with语句:
image.png
image.png
Sub test()
With ThisWorkbook.Sheets(1)
.Range("e1") = 1
.Range("e2") = 2
.Range("e3") = 3
End With
End Sub
DIR函数:
image.png
image.png
Sub test()
Dim fileName$
fileName = Dir("/Users/luowei/Downloads/")
Do
n = n + 1
Cells(n, "f").Value = fileName
fileName = Dir
Loop Until fileName = ""
End Sub
超链接:
image.png
image.png
image.png
image.png
Sub test()
Sheet1.Hyperlinks.Add Range("e1"), "/Users/luowei/Downloads/计算机组成原理.pdf", "a1", "ti shi", "xianshi"
End Sub
合并单元格:
image.png
instr函数:
image.png
image.png
Sub test()
MsgBox InStr(Range("f4"), ".")
End Sub
like运算符:
image.png
image.png
image.png
Sub test()
MsgBox "12" Like "?2"
End Sub
name语句:
image.png
image.png
Sub test()
Name "/Users/luowei/Downloads/tt.xlsx" As "/Users/luowei/Downloads/test.xlsx"
End Sub
不同单元格填充不同颜色:
image.png
批量移动文件:
image.png
mkdir:
image.png
Sub test()
MkDir ThisWorkbook.Path & "/tset"
End Sub
数组写入和读取
image.png
Sub test()
' arr = Array(1, 2, 3)
' Range("a1:c1") = arr
' arr = Range("a1:a3")
' Range("b1:b3") = arr
'arr = Range("a1:a3")
'Range("a1:c1") = WorksheetFunction.Transpose(arr)
arr = Range("a1").CurrentRegion
Range("a5:c10") = WorksheetFunction.Transpose(arr)
End Sub
for循环遍历数组
image.png
Sub test()
arr = Range("a1").CurrentRegion
For i = 2 To 4
Cells(i + 5, 1) = arr(i, 1)
For j = 2 To 3
totalResult = totalResult + arr(i, j)
Next
Cells(i + 5, 2) = totalResult
totalResult = 0
Next
End Sub
数组的声明
image.png
Sub test()
'生成一维数组,数组下标从0开始
' Dim arr(4)
'as integer指定数组的类型为数值类型
' Dim arr(3) As Integer
'生成一维数组,数组下标从1开始
' Dim arr(1 To 3)
'声明二维数组
Dim arr(1 To 3, 1 To 2)
End Sub
动态数组
image.png
Sub test()
Dim arr(), brr()
arr = Range("a7").CurrentRegion
For i = 1 To 4
If arr(i, 1) = Range("d7").Value Then
n = n + 1
'redim重新定义数组大小,preserve重新定义数组大小时,不清除以前的值
ReDim Preserve brr(n)
brr(n) = arr(i, 2)
End If
Next i
MsgBox WorksheetFunction.Sum(brr)
End Sub
声明数组时使用变量,使用redim声明数组
Sub test()
i = 1 + 1
'如果声明数组时,使用了变量,那么定义数组应该使用redim关键字
ReDim arr(1 To i)
End Sub
数组的ubound
image.png
Sub test()
Dim arr(1 To 3, 2 To 5)
'返回数组一维的上标
MsgBox UBound(arr, 1)
'返回数组二维的上标
MsgBox UBound(arr, 2)
'返回数组二维的下标
MsgBox LBound(arr, 2)
End Sub
image.png
Sub test()
Dim arr(), brr(1 To 40, 1 To 3)
arr = Range("a1").CurrentRegion
For i = 2 To UBound(arr)
For j = 2 To UBound(arr, 2)
n = n + 1
brr(n, 1) = arr(i, 1)
brr(n, 2) = arr(1, j)
brr(n, 3) = arr(i, j)
Next
Next
Range("e2").Resize(UBound(brr), 3) = brr
End Sub
利用数组进行冒泡排序
Sub test()
arr = [a10:d10]
arr = WorksheetFunction.Transpose(WorksheetFunction.Transpose(arr))
For i = 1 To UBound(arr) - 1
For j = 1 To UBound(arr) - i
If arr(j) > arr(j + 1) Then
temp = arr(j + 1)
arr(j + 1) = arr(j)
arr(j) = temp
End If
Next
Next
Range("a11").Resize(1, 4) = arr
End Sub
拆分函数split
image.png
Sub test()
Dim str As String
str = "zhang,li,zhao"
arr = Split(str, ",")
For i = LBound(arr) To UBound(arr)
MsgBox arr(i)
Next
End Sub
join函数
image.png
Sub test()
Dim arr()
arr = Array(1, 2, 3)
MsgBox Join(arr, "-")
End Sub
筛选函数filter
image.png
Sub test()
arr = Array(12, 142, 43)
brr = Filter(arr, "1")
MsgBox Join(brr, "-")
End Sub
工作表函数
image.png
Sub test()
arr = [a1].CurrentRegion
brr = WorksheetFunction.Index(arr, 0, 1)
brr = WorksheetFunction.Transpose(brr)
r = WorksheetFunction.Match([e1], brr, 0)
Range("d2:e2") = WorksheetFunction.Index(arr, r, 0)
End Sub
数组去除空值
image.png
Sub test()
arr = WorksheetFunction.Transpose(Range("a1:a10"))
t = Join(arr)
t = WorksheetFunction.Trim(t)
arr = Split(t)
Range("b1:b6") = WorksheetFunction.Transpose(arr)
End Sub
清空数组
Sub test()
Dim arr()
arr = Array("zhagn", "li")
'使用erase删除指定数组中的数据
Erase arr
MsgBox 1
End Sub
提取数组的唯一值
Sub test()
On Error Resume Next
Dim brr()
arr = Range("a1:a11")
ReDim brr(1 To UBound(arr))
For i = LBound(arr) To UBound(arr)
'判断a数组中的项,在b数组中是否存在,如果不存在就放到b数组
n = WorksheetFunction.Match(arr(i, 1), brr, 0)
If n = "" Then
j = j + 1
brr(j) = arr(i, 1)
End If
n = ""
Next
MsgBox Join(brr)
End Sub
字典的add、keys、items方法
Sub test()
Set dic = CreateObject("scripting.dictionary")
'该方法添加条目到字典
dic.Add "zhang", "san"
dic.Add "li", "si"
'返回字典的所有条目
arr = dic.items
MsgBox arr(0)
'返回字典的所有键
brr = dic.keys
MsgBox brr(0)
End Sub
字典的exists、Remove、RemoveAll方法
Sub test()
Set dic = CreateObject("Scripting.dictionary")
dic("1") = 1
'判断是否存在对应的键
MsgBox dic.exists("1")
'删除对应的键和值
dic.Remove ("1")
'删除所有对键和值
dic.RemoveAll
End Sub
字典的count、comparemode属性
Sub test()
Set dic = CreateObject("Scripting.dictionary")
'设置字典的键是否区分大小写,0为区分,1为不区分,必须在未填写进值之前设置
dic.comparemode = 1
dic("1") = 1
dic.Item("2") = 2
dic.Key("2") = 3
'返回字典中键的总数
MsgBox dic.Count
End Sub
正则表达式
Sub test()
Dim sj As Variant, ss As Variant
'后期绑定
Set reg = CreateObject("vbscript.regexp")
With reg
'设置全局搜索
.Global = True
'设置匹配模式
.Pattern = "\d+"
'执行匹配
Set sj = .Execute("我123")
For Each ss In sj
MsgBox ss
Next
End With
End Sub
正则表达式replace替换字符串
Sub test()
Dim sj As Variant, ss As Variant
'后期绑定
Set reg = CreateObject("vbscript.regexp")
With reg
'设置全局搜索
.Global = True
'设置匹配模式
.Pattern = "\d+"
'执行匹配
Set sj = .Execute("我123")
For Each ss In sj
'Replace替换字符串
MsgBox .Replace(ss, "**")
Next
End With
End Sub
正则表达式test方法
Sub test()
Dim sj As Variant, ss As Variant
'后期绑定
Set reg = CreateObject("vbscript.regexp")
With reg
'设置全局搜索
.Global = True
'设置匹配模式
.Pattern = "\d+"
'执行匹配
If .test("d122") Then
MsgBox "数据匹配正则表达式"
End If
End With
End Sub
设置指定字符串对应字符的背景颜色
Sub test1()
'设置指定字符串对应字符的背景颜色
[i7].Characters(2, 3).Font.Color = 255
End Sub
排除匹配
Sub test()
Dim sj As Variant, ss As Variant
'后期绑定
Set reg = CreateObject("vbscript.regexp")
With reg
'设置全局搜索
.Global = True
'设置匹配模式:匹配不是数字的字符串,^符号代表取非操作
.Pattern = "[^\d+]+"
'执行匹配
Set sj = .Execute("cdasd212")
For Each ss In sj
MsgBox ss
Next
End With
End Sub
后向引用
Sub test()
Dim sj As Variant, ss As Variant
'后期绑定
Set reg = CreateObject("vbscript.regexp")
With reg
'设置全局搜索
.Global = True
'\1代表后向引用前面第一个括号内的内容
.Pattern = "(\d{3}).*\1"
'执行匹配
MsgBox .test("123za12")
End With
End Sub
贪婪与懒惰匹配
image.png
muiltiline多行模式
image.png
零宽断言
image.png
image.png
匹配引号
image.png
自定义函数
image.png
image.png
自定义函数默认参数
image.png
事件
image.png
image.png
记录工作表修改时间
image.png
表单组件-单选框
image.png
image.png
image.png
多个单选框放入框架中
image.png
image.png
表单组件-复选框
image.png
image.png
image.png
表单组件-复合框
image.png
image.png
image.png
表单组件-listview控件
工具栏加载list控件
image.png
关于附加组件后显示“未知”,无法调用的问题。
image.png
解决方法是注册MSCOMCTL.OCX
image.png
将excel中的数据显示到listview中
image.png
image.png
'添加listview的表头
Private Sub CommandButton1_Click()
Dim i As Integer, columnNum As Integer
With ListView1
columnNum = Range("a1").End(xlToRight).Column
For i = 1 To columnNum
.ColumnHeaders.Add i, , Cells(1, i).Value, .Width / columnNum, lvwColumnLeft
Next
.Gridlines = True
.FullRowSelect = True
.View = lvwReport
End With
End Sub
'添加listview的数据
Private Sub CommandButton2_Click()
Dim i As Integer, j As Integer, rowNum As Integer, columnNum As Integer, listItem As listItem
With ListView1
columnNum = Range("a1").End(xlToRight).Column
rowNum = Range("a1").End(xlDown).Row
For i = 2 To rowNum
'每一条数据为一个listItem
Set listItem = .ListItems.Add()
'每一条数据的第一列为Text
listItem.Text = Cells(i, 1)
For j = 2 To columnNum
'每一条数据从第二列开始为SubItems
listItem.SubItems(j - 1) = Cells(i, j)
Next
Next
End With
End Sub