这个笔记是在看了VBA全套教程视频后写的。Microsoft excle教程。
一、录制宏
如果不会写vba代码,就直接点击开发工具栏下的录制宏按钮吧,然后在执行正常的excle操作,操作完成之后,点击停止录制按钮,就可以得到一段vba代码了。如果要执行相同的操作,就可以直接执行这个代码。
二、基本元素
- 基本使用
Sub exampleName
//选择工作簿中的工作簿中的cell单元格
Workbooks(name).Worksheets(name).Range(cell)
End Sub
- 一些方法
//Range
//单元格
Range(cell).value="value"
//区域
Range("A1:B10").value="value"
//多个不连续,用逗号分隔
Range("A1,B10").value="value"
//cells引用,第一个为数字,第二个为数字或字母
cells(5,6).value="value" //表示第五行第六列
//[]中括号
[B3].value="value"
//行、列引用
Rows("3:10").Rows(1).Select //表示选中第三行到第10行中的第一行
Columns("B:G").columns(2).Select
//offset属性(相对位置):(x,y) x>0,下;y>0,右
//End属性(末端):xlToLeft,xlToRight,xlToUp,xlToDown
Range("A1").End(xlDown).Offset(1,0)="value"
- 窗体控件和变量
//InputBox: 获取数据
temp = InputBox("please enter") // 输入的数据被存入到temp中
- 简单处理一张表
Sub cellformat()
set tatblehead = Range("B2:G4")
tablehead.Merge //合并表头
tablehead.HorizontalAlignment = xlCenter //表头内容居中
//字体设置: ColorIndex,Bold
tablehead.Font.Size = 12 // 设置字体大小
tablehead.Interior.ColorIndex = 15 //背景色
Range("B4:G10").Borders.LineStyle = True //边框
End Sub
- 循环、if判断、select
// for 循环
for i = 1 To 5
Worksheets.Add //增加工作表
next i
for each i in Range("A1:A10")
i.value= i
// while 循环
i = 1
do while i <= 5
WorkSheets.add
i = i + 1
Loop
i = 1
do
WorkSheets.add
i = i + 1
Loop while i <= 5
// if
if Range("B2").Value >= 90 Then
Range("C2").Value = "优秀"
ElseIf Range("B2").Value >= 80
Range("C2").Value = "良好"
Else
Range("C2").Value = "及格"
// Select
Select Case Range("B2").Value
Case Is >=90
Range("C2").Value = "优秀"
Case Is >=80
Range("C2").Value = "良好"
Case Else
Range("C2").Value = "不及格"
End Select
//结合for 和 Select
For i = 2 To 10
Select Case Range("B"&i)
......
End Select
Next i
- 数据类型和数组
//声明
dim array(1 to 10,1 to 10) as integer //10*10的数字数组
//动态数组:可以实时更新
dim array( 动态范围 ) as 数据类型
redim array( 上届、下届 ) as 数据类型
//example
Dim arr(), i as Integer
x = Sheets.Count
ReDim arr( 1 to x )
for i = 1 to x
arr(i) = Sheets(i).Name
Range("A"&i).Value = arr(i)
Next i
//特殊数组声明
Dim arr1,arr2 As Variant
arr1 = Array(1,2,3,4,5) //创建一个长度为5的数组,其中的值分别是1,2,3,4,5
arr2 = Split("1*2*3","*")//将字符串用*分割得到新的数组
//数组写入
Range("A1:C1").Value = arr
- 运算符和内置函数
//算数:+ - * / ....
//比较:like ....
//逻辑:or and ....
//vba.函数
- 事件
//工作表的一个事件代码:填写(选择)了单元格后自动计算内容
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim olddata, newdata, changedata, ratedata As Double
If Not Intersect(Target, Range("C2:C5")) Is Nothing Then
olddata = Target.Value
newdata = Target.Offset(0, -1).Value
If IsNumeric(olddata) And IsNumeric(newdata) Then
changedata = olddata - newdata
Target.Offset(0, 1).Value = changedata
If changedata <> 0 Then
Target.Offset(0, 2).Value = changedata / 10
Else
Target.Offset(0, 2).Value = 0
End If
Else
Target.Offset(0, 1).Value = ""
Target.Offset(0, 2).Value = ""
End If
End If
End Sub
- 函数参数
//两个数相加,返回一个数
//byVal 声明参数
function func( ByVal num1 as Integer,ByVal num2 as Integer) As Integer
add = num1 + num2
End Function
- 类事件方法
//Application.onKey
Sub onKey()
Application.onkey"+e","subname" //自定义快捷键 sheet+e,增加工作表
End Sub
Sub sunname()
wordsheet.add after:=worksheets(worksheets.Count) //在工作表后新增
ActiveSheet.Name = "工作表"& worksheets.Count
End Sub
//Application.onTime
三、实战
1. 用户窗体:输入、查询、编辑、删除
' 窗体代码
Public EnableEvents As Boolean ' 声明全局事件
Private Sub firstInputData()
' 内容输入,返回需要输入数据的行号
lastrow = Worksheets("data").Cells(Rows.Count, 1).End(xlUp).Row + 1
' 填充外边框
With Range(Cells(lastrow, 1), Cells(lastrow, 6)).Borders
.LineStyle = xlContinuous ' 边框设置为实线条
.Weight = xlThin ' 边框的粗细设置为中细线
End With
' 添加数据
Worksheets("data").Cells(lastrow, 1).Value = username.Text
' 将文本框中的文本传入到对应的单元格中
If man.Value = True Then
Worksheets("data").Cells(lastrow, 2).Value = "man"
End If
If woman.Value = True Then
Worksheets("data").Cells(lastrow, 2).Value = "woman"
End If
If reading.Value = True Then
Worksheets("data").Cells(lastrow, 3).Value = "是"
End If
If newspaper.Value = True Then
Worksheets("data").Cells(lastrow, 4).Value = "是"
End If
If sleep.Value = True Then
Worksheets("data").Cells(lastrow, 5).Value = "是"
End If
Worksheets("data").Cells(lastrow, 6).Value = ListBox1.Value
End Sub
Sub clearData()
' 清除表单数据
nameid.Value = ""
username.Value = ""
man.Value = False
woman.Value = False
newspaper.Value = False
reading.Value = False
sleep.Value = False
ListBox1.Value = ""
' 清空部门中的信息,并重新添加信息进去
department.Clear
department.AddItem "人事部"
department.AddItem "财务部"
department.AddItem "技术部"
'调用添加搜索
Call addSearch
Worksheets("data").AutoFilterMode = False '关闭查询下拉框
Worksheets("search").AutoFilterMode = False
Worksheets("search").Cells.Clear
' 返回已有数据的最大行
irow = Worksheets("data").Cells(Rows.Count, 1).End(xlUp).Row
With ListBox2
.ColumnCount = 9 '设置列
.ColumnHeads = False '不显示标题
.ColumnWidths = "40,60,60,50,60,60,60,60,60,60" '设置列宽
' RowSource 引用区域
If irow > 2 Then
.RowSource = "data!A2:I" & irow ' 显示所有数据
Else
.RowSource = "data!A2:I2" ' 只显示标题
End If
End With
End Sub
Private Sub ComboBox2_Change()
' me 指代当前窗体
If Me.EnableEvents = False Then Exit Sub
If Me.ComboBox2.Value = "全部" Then
Call clearData
Else
Me.TextBox2.Value = ""
Me.TextBox2.Enabled = True
Me.CommandButton4.Enabled = True
End If
End Sub
Private Sub CommandButton1_Click()
' 联动传入数据按钮
Dim msgValue As VbMsgBoxResult
msgValue = MsgBox("是否要传入数据?", vbYesNo + vbInformation, "确认")
If msgValue = vbNo Then Exit Sub
Call submitData
Call clearData
End Sub
Private Sub CommandButton2_Click()
' 联动传入数据按钮
Dim msgValue As VbMsgBoxResult
msgValue = MsgBox("是否要清楚数据?", vbYesNo + vbInformation, "确认")
If msgValue = vbNo Then Exit Sub
Call clearData
End Sub
Private Sub CommandButton3_Click()
' 退出表单
Unload UserForm1
End Sub
Private Sub CommandButton4_Click()
If Me.TextBox2.Value = "" Then
MsgBox "请输入想要查询的值", vbOKOnly + vbInformation, "查询"
Exit Sub
End If
Call searchData
End Sub
Private Sub CommandButton5_Click()
'编辑数据
If Select_row = 0 Then
MsgBox "未选择数据", vbOKOnly + vbInformation, "编辑"
Exit Sub
End If
Call editData
End Sub
Private Sub CommandButton6_Click()
' 删除数据
Dim irow As Long
Dim i As VbMsgBoxResult
If Select_row = 0 Then
MsgBox "未选择删除数据", vbYesNo + vbInformation, "删除"
End If
irow = Select_row + 1
i = MsgBox("确认要删除吗", vbYesNo + vbInformation, "删除")
If i = vbNo Then Exit Sub
Worksheets("data").Rows(irow).Delete
'删除数据后重置数据
Call clearData
MsgBox "所选数据已删除", vbOKOnly + vbInformation, "删除"
End Sub
Private Sub UserForm_Initialize()
' 表单初始化
' 声明变量
Dim i As Integer
r = Worksheets("province").Cells(Rows.Count, 1).End(xlUp).Row
' End(xlUp) 从最后一个单元格往上数,数到第一个有数据的单元格
' Row 获取行号
For i = 1 To r
ListBox1.AddItem Worksheets("province").Cells(i, 1).Value
Next i
Call clearData ' da调用清除是为了将下方结果呈现出来
End Sub
Sub addSearch()
' 查询事件
EnableEvents = False ' 禁用事件(这一句代码下方的代码不会被重复运行)
With ComboBox2
.Clear
.AddItem "全部"
.AddItem "姓名id"
.AddItem "姓名"
.AddItem "性别"
.AddItem "部门"
.AddItem "省份"
.Value = "全部"
End With
EnableEvents = True ' 启用事件
TextBox2.Value = "" ' 传入空值
TextBox2.Enabled = False '不允许编辑
CommandButton4.Enabled = False ' 不允许点击
End Sub
' 模块代码
Sub submitData()
' 内容输入,返回需要输入数据的行号
Dim i As Integer
'lastrow = Worksheets("data").Cells(Rows.Count, 1).End(xlUp).Row + 1
' 区分新增或修改
If Select_row < 0 Then
lastrow = Worksheets("data").Cells(Rows.Count, 1).End(xlUp).Row + 1
Else
lastrow = Select_row + 1
End If
' 填充外边框
With Range(Cells(lastrow, 1), Cells(lastrow, 9)).Borders
.LineStyle = xlContinuous ' 边框设置为实线条
.Weight = xlThin ' 边框的粗细设置为中细线
End With
' 使用with语句添加数据
With Worksheets("data")
.Cells(lastrow, 1).Value = lastrow - 2
.Cells(lastrow, 2).Value = UserForm1.nameid.Text
.Cells(lastrow, 3).Value = UserForm1.username.Text
' 将文本框中的文本传入到对应的单元格中
If UserForm1.man.Value = True Then
Worksheets("data").Cells(lastrow, 4).Value = "man"
End If
If UserForm1.woman.Value = True Then
Worksheets("data").Cells(lastrow, 4).Value = "woman"
End If
' 部门信息
.Cells(lastrow, 5).Value = UserForm1.department.Value
' 爱好信息
If UserForm1.reading.Value = True Then
Worksheets("data").Cells(lastrow, 6).Value = "是"
End If
If UserForm1.newspaper.Value = True Then
Worksheets("data").Cells(lastrow, 7).Value = "是"
End If
If UserForm1.sleep.Value = True Then
Worksheets("data").Cells(lastrow, 8).Value = "是"
End If
' 省份信息
.Cells(lastrow, 9).Value = UserForm1.ListBox1.Value
End With
End Sub
Sub searchData()
Application.ScreenUpdating = False '取消屏幕更新
Dim shData As Worksheet
Dim shSearch As Worksheet '数据表对象,查询表对象
Dim iColumn As Integer ' 数据表中所选择的列号
Dim iDataRow As Long
Dim iSearchRow As Long ' 数据表和查询表中最大的行号
Dim sColumn As String
Dim sValue As String '查询的列名称、值
Dim m 'variant
' 给表对象复制
Set shData = Worksheets("data")
Set shSearch = Worksheets("search")
iDataRow = shData.Cells(Rows.Count, 1).End(xlUp).Row '返回数据表中有数据的最大行
sColumn = UserForm1.ComboBox2.Value ' 查询列名称(方式)
sValue = UserForm1.TextBox2.Value ' 查询的内容
iColumn = Application.WorksheetFunction.Match(sColumn, Worksheets("data").Range("A2:I2"), 0)
' match函数返回查询方式是表中的第几个标题,返回的是数值
If shData.FilterMode = True Then '取消筛选(默认不筛选)
shData.AutoFilterMode = False
End If
'添加筛选
If UserForm1.ComboBox2.Value = "姓名id" Then
shData.Range("A2:I" & iDataRow).AutoFilter field:=iColumn, Criteria1:=sValue
' shData.Range("A2:I" & iDataRow) 筛选区域
'AutoFilter 开始筛选
'field:=iColumn 筛选字段
'Criteria1:=sValue 筛选条件
Else
Worksheets("data").Range("A2:I" & iDataRow).AutoFilter field:=iColumn, Criteria1:="*" & sValue & "*"
End If
' 开始筛选
If Application.WorksheetFunction.Subtotal(3, Worksheets("data").Range("C:C")) >= 2 Then
'对数据表中筛选出来的数据进行计数
' Subtotal: 返回列表中的分类汇总。 3:表示计数
Worksheets("search").Cells.Clear ' 清空查询表中的数据
Worksheets("data").AutoFilter.Range.Copy shSearch.Cells(1, 1) '将筛选出来的数据复制到查询表中
Application.CutCopyMode = False '取消剪切或复制
iSearchRow = shSearch.Cells(Rows.Count, 1).End(xlUp).Row '返回查询表中存在的数据最大行
UserForm1.ListBox2.ColumnCount = 9
UserForm1.ListBox2.ColumnWidths = "40,60,60,50,60,60,60,60,60,60"
If iSearchRow > 1 Then
UserForm1.ListBox2.RowSource = "search!A1:I" & iSearchRow
MsgBox "数据已找到"
End If
Else
MsgBox "未查询到数据"
End If
Worksheets("data").AutoFilterMode = False '关闭查询的下拉框
Application.ScreenUpdating = False '查询的原始数据屏幕不更新
End Sub
' 定义一个函数,用于返回选择的数据行
Function Select_row() As Long
Dim i As Integer
Select_row = 0
'从第一行遍历到最后一行
For i = 0 To UserForm1.ListBox2.ListCount - 1
' 结果框中的数据,最后一行是ListCount-1
If UserForm1.ListBox2.Selected(i) = True Then
' 表示选择了某一行数据
Select_row = i + 1 '表示选择的数据表中的行号
Exit For
End If
Next
End Function
' 编辑数据
Sub editData()
Dim gender As String
Dim us1 As UserForm1
Set us1 = UserForm1
' 重新赋值
' us1.ListBox2.ListIndex 返回的是结果框中的行号,如果没选择数据,行号为-1
' 选择了数据时,行号从0起开始往下数
us1.nameid.Value = us1.ListBox2.List(us1.ListBox2.ListIndex, 1) '显示姓名id中的值
us1.username.Value = us1.ListBox2.List(us1.ListBox2.ListIndex, 2)
gender = us1.ListBox2.List(us1.ListBox2.ListIndex, 3)
If gender = "man" Then
us1.man.Value = True
Else
us1.woman.Value = True
End If
us1.department.Value = us1.ListBox2.List(us1.ListBox2.ListIndex, 4)
us1.reading.Value = us1.ListBox2.List(us1.ListBox2.ListIndex, 5)
us1.newspaper.Value = us1.ListBox2.List(us1.ListBox2.ListIndex, 6)
us1.sleep.Value = us1.ListBox2.List(us1.ListBox2.ListIndex, 7)
us1.ListBox1.Value = us1.ListBox2.List(us1.ListBox2.ListIndex, 8)
MsgBox "重新传入可更新数据", vbOKOnly + vbInformation, "编辑"
End Sub
注: 可正常运行,非常规操作有部分bug
2. 正则表达式
符号 | 含义 | 符号 | 含义 |
---|---|---|---|
^ | 以开头 | * | 匹配0个或多个*号前的字符 |
$ | 以结尾 | + | 匹配1个多个+号前的字符 |
. | 匹配任意一个 | ? | 匹配0个或1个?号前的字符 |
[] | 匹配[]中的任意字符 | 匹配出现n次的字符 | |
[^] | 匹配除了[]中的任意字符 | 区间匹配,匹配出现n到m次之间的字符 | |
a|b | 匹配a或者b | (ab) | 匹配(ab) |
\d | 匹配数字,[0-9] | \D | 匹配除数字外的字符 |
\s | 匹配空白符,[\f\t\n\r\v] | \S | 匹配非空白符 |
\w | 匹配字母、下划线和数字,[a-zA-Z0-9_] | \W | 匹配非前面 |
\ | 转义字符 |
特殊匹配:
-
匹配中文,用编码匹配
[\u4e00-\u9fa5]+
-
两段vba匹配代码
' 自定义的一个函数,使用方式同excle自带的函数一样
Function regTotal(text As String)
Dim reg As Object
Set reg = CreateObject("VBScript.RegExp")
Dim total As Single
total = 0
With reg
.Global = True 'Ture 查找所有匹配值,false 查找第一个匹配的值
.Pattern = "\d+\.?\d*"
Set mc = .Execute(text)
For Each i In mc
total = total + i
Next
regTotal = total '返回总计
End With
End Function
' 定义一个执行过程
Sub phoneExtract()
Dim reg As Object
Set reg = CreateObject("VBScript.RegExp")
Dim rng As Range
Dim row As Integer
Set rng = Worksheets("reg").Range("A8", Cells(Rows.Count, 1).End(xlUp))
row = 8
For Each r In rng
Debug.Print (r)
With reg
.Global = False
.ignorecase = True '忽略大小写
.Pattern = "([a-z]+\d*[a-z]*)([\u4e00-\u9fa5]+)(\d+)元(\d+)"
Set mc = .Execute(r)
For Each i In mc
Debug.Print (i.submatches(0))
Worksheets("reg").Range("B" & row) = i.submatches(0)
Worksheets("reg").Range("C" & row) = i.submatches(1)
Worksheets("reg").Range("D" & row) = i.submatches(2)
Worksheets("reg").Range("E" & row) = i.submatches(3)
Next
row = row + 1
End With
Next
End Sub
标签:vba,End,Sub,Cells,知识,Value,Range,Worksheets
From: https://www.cnblogs.com/xxjing/p/17441033.html