vba小知识

这个笔记是在看了VBA全套教程视频后写的。Microsoft excle教程。

一、录制宏

如果不会写vba代码，就直接点击开发工具栏下的录制宏按钮吧，然后在执行正常的excle操作，操作完成之后，点击停止录制按钮，就可以得到一段vba代码了。如果要执行相同的操作，就可以直接执行这个代码。

二、基本元素

1. 基本使用

Sub exampleName
//选择工作簿中的工作簿中的cell单元格
Workbooks(name).Worksheets(name).Range(cell)
End Sub

2. 一些方法

//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"

3. 窗体控件和变量

//InputBox： 获取数据
temp = InputBox("please enter") // 输入的数据被存入到temp中

4. 简单处理一张表

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

5. 循环、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

6. 数据类型和数组

//声明
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

7. 运算符和内置函数

//算数：+ - * / ....
//比较：like .... 
//逻辑：or and  ....

//vba.函数

8. 事件

//工作表的一个事件代码：填写（选择）了单元格后自动计算内容
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

9. 函数参数

//两个数相加，返回一个数
//byVal 声明参数
function func( ByVal num1 as Integer,ByVal num2 as Integer) As Integer
  add = num1 + num2
End Function

10. 类事件方法

//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. 正则表达式

特殊匹配：

1. 匹配中文，用编码匹配

   [\u4e00-\u9fa5]+

2. 两段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批量 调整表格 大小
• 一些Mybatis的知识点&易错点总结
• 寒假1高数知识部分
• 网络基础知识学习
• 零知识证明的最新发展和应用
• Elastic 安全相关知识
• 矩阵相关知识图谱
• 数据库基本理论知识
• 【C/C++】知识点笔记

知识 vba知识vba vba 日期vba vba-excel vba-redim 代码 知识vba 中英vba solidworks文档vba 文件vba picture paste copy vba