首页 > 其他分享 >vba小知识

vba小知识

时间：2023-05-29 17:12:07浏览次数：42  
标签：vba End Sub Cells 知识 Value Range Worksheets

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

一、录制宏

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

二、基本元素

  1. 基本使用
Sub exampleName
//选择工作簿中的工作簿中的cell单元格
Workbooks(name).Worksheets(name).Range(cell)
End Sub
  1. 一些方法
//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"
  1. 窗体控件和变量
//InputBox： 获取数据
temp = InputBox("please enter") // 输入的数据被存入到temp中
  1. 简单处理一张表
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
  1. 循环、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
  1. 数据类型和数组
//声明
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
  1. 运算符和内置函数
//算数：+ - * / ....
//比较：like .... 
//逻辑：or and  ....

//vba.函数
  1. 事件

image

//工作表的一个事件代码：填写（选择）了单元格后自动计算内容
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
  1. 函数参数
//两个数相加，返回一个数
//byVal 声明参数
function func( ByVal num1 as Integer,ByVal num2 as Integer) As Integer
  add = num1 + num2
End Function
  1. 类事件方法
//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. 用户窗体：输入、查询、编辑、删除

image
image

' 窗体代码
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 匹配非前面
\ 转义字符

特殊匹配：

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

    [\u4e00-\u9fa5]+

  2. 两段vba匹配代码

image

' 自定义的一个函数，使用方式同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

image

' 定义一个执行过程
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

相关文章

  • HTTPS基础知识
    HTTPS并非是应用层的一种新协议。只是HTTP通信接口部分用SSL（SecureSocketLayer）和TLS（TransportLayerSecurity）协议代替而已。通常，HTTP直接和TCP通信。当使用SSL时，则演变成先和SSL通信，再由SSL和TCP通信了。简言之，所谓HTTPS，其实就是身披SSL协议这层外壳的HTTP。SSL是独立于HTTP的协......
  • 关于VBA的TextStream StdOut相关程序的学习——源代码（刘永富博士的ExcelVBA编程开发）
    Subtest3()'标准输出-查找相关目录下所有的GIF格式文件。DimTS1AsIWshRuntimeLibrary.TextStreamDimTS2AsIWshRuntimeLibrary.TextStreamSetWShell=NewIWshRuntimeLibrary.WshShellSetWE=WShell.Exec("cmd.exe/k")SetTS1=WE.StdInTS1.......
  • 1.5万字+30张图盘点索引常见的11个知识点
    大家好，我是三友~~今天来盘点一下关于MySQL索引常见的知识点本来这篇文章我前两个星期就打算写了，提纲都列好了，但是后面我去追《漫长的季节》这部剧去了，这就花了一个周末的时间，再加上后面一些其它的事，导致没来得及写不过不要紧，好饭不怕晚，虽迟但到，走起，开干！对了，本文主要是针对Inn......
  • 1万多公务员考试基础知识题库ACCESS数据库
    《公务员考试基础知识题库ACCESS数据库》搜集了大量公务员考试试题，包括公共基础知识试题、行政职业能力试题、法律基础知识试题、公安基础知识试题等。分类记录统计情况为：法律基础知识试题（共1359条）、公安基础知识试题（共1709条）、公共基础知识试题（共2905条）、行政职业能力试题（共661......
  • 有关 PID 控制的入门理论知识
     PID控制算法是自动控制中的一个非常典型且重要的算法，可以明确的说，对于学自动控制的朋友来说，不懂PID控制，那就等于没真正的学过自动控制。PID的应用其实在我们的生活中是很普遍的，它不止浮现于算法介绍的文献中，在生活中也是应用广泛的、比如我们日常使用的恒温热水器、液位稳定系统，......
  • 执行VBA出现3706错误的解决方案
    现在自用电脑只安装wps，没有安装office了，执行vba居然报3706错误，代码调试好了没改动，那么只有一种可能就是数据库连接有问题了。出现这个提示，安装AccessDatabaseEngine.exe，即可Access 2010数据库引擎：https://download.csdn.net/download/weixin_42750611/12409896安装注意事项：①......
  • 网安--Linux操作系统基础知识
    1、Linux系统结构（1）内核1、管理进程（2）shell（包围在内核外的壳）接收用户的命令，经过转换，交给内核去执行查看shell工具 切换shell工具chsh-s例：chsh-s/bin/csh shell编程/shell脚本（.sh)#!/bin/bash（3）文件系统 "一切皆文件"：以文件的方式进行访问lsof/bin/bash 查......
  • 答辩准备，知识问题等
    架构和框架的区别框架是一种编程工具，它是一个预定义的结构，包含了一系列的类、函数、方法等，可以帮助开发者快速搭建应用程序，提高开发效率。框架通常提供了一些通用的功能，例如数据库访问、用户认证、会话管理等，开发者可以在此基础上进行二次开发，根据自己的需求进行扩展。架构是一......
  • 每日总结小知识
    CSS中的display和visibility css中display和visibility语法，他们都可以隐藏和显示html元素。看齐来他们很相似，所以很多人还是会搞错。谈们的属性分别如下：display:none|block;display:none;时隐藏该html元素，确切的说，是在浏览器中消除该元素，不占屏幕的空间。若其下有其他元素，就会......
  • 通俗直观介绍ChatGPT背后的大语言模型理论知识
    “AI的iPhone时刻到来了”。非算法岗位的研发同学'被迫'学习AI，产品岗位的同学希望了解AI。但是，很多自媒体文章要么太严谨、科学，让非科班出身的同学读不懂；要么，写成了科幻文章，很多结论都没有充分的逻辑支撑，是‘滑坡推理’的产物。这篇文章从底层讲起，却不引入太多概念，特别是数......

赞助商

阅读排行

网站主页关于我们联系我们网站地图

本网站内容转载自其他媒体，侵权联系[admin##ips99.com]。

Copyright © 2020-2023 IPS99 版权所有 IPS99