Visual Basic for Applications(VBA)是一种Visual Basic的一种宏语言,主要能用来扩展Windows的应用程式功能,特别是Microsoft Office。也可说是一种应用程式视觉化的Basic Script。本文总结了一些VBA的常用代码。
Visual Basic for Applications(VBA)是一种Visual Basic的一种宏语言,主要能用来扩展Windows的应用程式功能,特别是Microsoft Office。也可说是一种应用程式视觉化的Basic Script。下面总结了一些VBA的常用代码。
1. 单元格操作
1.1 Range
赋值:Set data = Sheets("Sheet1").range("A1:B6")
清除:Range("A1:C3").ClearContents
偏移:Set newrange = Range("A1").Offset(0, 1)
2. 文件读写
2.1 Excel文件
Application.ScreenUpdating = False
Dim app as New Excel.Application
app.Visible = False
Dim book As Excel.Workbook
Set book = app.Workbooks.Add(fileName)
'
' 在这里添加任务代码
'
book.Close SaveChanges:=False
app.Quit
Set app = Nothing
Application.ScreenUpdating = True
2.2 文本文件
OpenTextFile(filename[, iomode[, create[, format]]]):打开指定的文件并返回一个 TextStream 对象,可以通过这个对象对文件进行读、写或追加。
参数
object:必选项。 object 应为 FileSystemObject 的名称。
filename:必选项。 指明要打开文件的字符串表达式。
iomode:可选项。 可以是三个常数之一: ForReading 、 ForWriting 或 ForAppending 。
create:可选项。 Boolean 值,指明当指定的 filename 不存在时是否创建新文件。 如果创建新文件则值为 True ,如果不创建则为 False 。 如果忽略,则不创建新文件。
format:可选项。 使用三态值中的一个来指明打开文件的格式。 如果忽略,那么文件将以 ASCII 格式打开。
iomode:可选项。参数可以是下列设置中的任一种:
常数 值 描述
ForReading 1 以只读方式打开文件。 不能写这个文件。
ForWriting 2 以写方式打开文件
ForAppending 8 打开文件并从文件末尾开始写。
format:可选项。 参数可以是下列设置中的任一种:
值 描述
TristateTrue 以 Unicode 格式打开文件。
TristateFalse 以 ASCII 格式打开文件。
TristateUseDefault 使用系统默认值打开文件。
例子:
Set fs = CreateObject("Scripting.FileSystemObject")
Set file = fs.OpenTextFile("C:\example.txt", 2, True)
file.writeliine "It's a test."
file.Close
3. 获取路径
ActiveWorkbook.Path 得到所在的目录,没有最后一个“\”
ActiveWorkbook.FullName 得到完整的路径,包括文件名
CurDir(drive) 当前工作路径,例如
CurDir () 返回 "C:\Documents and Settings\user\My Documents"
CurDir ("G") 返回 "G:\
4. 对话框
4.1 文件夹对话框
树形目录:
Set objSheel = CreateObject("Shell.Application")
Set objFolder = obSheel.BrowseForFolder(0, "Select Directory", 0,0)
path = objFolder.self.path
上面方法有个问题,无法自定义默认的文件目录。借用文件选择对话框,可解决该问题,代码如下:
Function GetFolder(strPath As String) As String
Dim fldr As FileDialog
Dim sItem As String
Set fldr = Application.FileDialog(msoFileDialogFolderPicker)
With fldr
.Title = "Select a Folder"
.AllowMultiSelect = False
.InitialFileName = strPath
If .Show <> -1 Then GoTo NextCode
sItem = .SelectedItems(1)
End With
NextCode:
GetFolder = sItem
Set fldr = Nothing
End Function
4.2 文件对话框
Dim fd As FileDialog
Dim objfl As Variant
Dim filnam As String
Set fd = Application.FileDialog(msoFileDialogFilePicker)
With fd
.ButtonName = "Select"
.AllowMultiSelect = False
.Filters.Add "Text Files", "*.txt;*.csv;*.tab;*.asc", 1
.title = "Choose Transactions file to import"
.InitialView = msoFileDialogViewDetails
.Show
For Each objfl In .SelectedItems
filnam = objfl
Next objfl
On Error GoTo 0
End With
Set fd = Nothing
4. 图表操作
4.1 获取和修改图表名
按住shift键,鼠标选中图表,再松开shift键。名称框里会显示图表名,也可以在此修改图表名。
4.2 图表操作
下面是个具体例子,包含图表位置,尺寸,数据源等内容的设置
Sub Chart_Update()
Dim varColor As Variant
Dim Num_Rnd As Integer
varColor = Array("41", "50", "3", "4", "7")
'操作图表前,先关闭界面更新,结束后再开启。这样可以加快执行速度
Application.ScreenUpdating = False
Num_Rnd = Calc_Round_Num()
With Sheets("Gameboard").ChartObjects("Data")
' 位置和尺寸
.Left = 26
.Width = 898
.Top = 282
.Height = 367
With .Chart
.HasTitle = True
.ChartTitle.Text = "Normalized Data"
.Axes(xlCategory, xlPrimary).HasTitle = True
.Axes(xlCategory, xlPrimary).AxisTitle.Characters.Text = "Round Number"
.Axes(xlValue, xlPrimary).HasTitle = True
.Axes(xlValue, xlPrimary).AxisTitle.Characters.Text = "Ratio"
.Axes(xlCategory).MinimumScale = 0
.Axes(xlCategory).MaximumScale = 10
.Axes(xlCategory).Crosses = xlCustom
.Axes(xlCategory).CrossesAt = -100
With .Legend
.Top = 57
.Height = 248
.Left = 728
.Width = 155
End With
With .PlotArea
.Top = 47
.Height = 284
.Left = 30
.Width = 687
End With
'图表数据
For i = 1 To .SeriesCollection.Count
With .SeriesCollection(i)
.Name = "=Gameboard!r" & 22 + i & "c4"
.XValues = "=Gameboard!R17C9:R17C" & 8 + Num_Rnd
.Values = "=Gameboard!R" & 22 + i & "C9:R" & 22 + i & "C" & 8 + Num_Rnd
' 图表边界
With .Border
.ColorIndex = varColor(i - 1)
.Weight = xlMedium
.LineStyle = xlContinuous
End With
' 图表Marker
.MarkerForegroundColorIndex = varColor(i - 1)
.MarkerBackgroundColorIndex = varColor(i - 1)
.MarkerStyle = xlSquare
.MarkerSize = 5
End With
Next
End With
End With
Application.ScreenUpdating = True
End Sub
5. Sheet操作
5.1 遍历EXCEL中的Sheet,获取Sheet名
Dim sht As Worksheet
For Each sht In Sheets
MsgBox sht.name
Next sht
6. 内容查询
6.1 Range.Find 和 Range.FindNext的使用
With Worksheets(1).Range("a1:a500")
Set c = .Find(2, lookin:=xlValues)
If Not c Is Nothing Then
firstAddress = c.Address
Do
c.Value = 5
Set c = .FindNext(c)
Loop While Not c Is Nothing And c.Address <> firstAddress
End If
End With
7. 控件
7.1 调用Excel下方的状态栏
Application.DisplayStatusBar = True
Application.StatusBar = "Runing..."
7.2 获取Checkbox的值
isChecked = Sheets("Sheet1").Checkbox1.Value
8. 函数
8.1 InStr( [start], string, substring, [compare] )
start:是查找的开始位置. 如果被忽略, 则从字符串首位开始查询
string:被查找的字符串
substring: 要查找的子字符串
compare:可选项。 值有以下几种
选项 | 值 | 解释 |
vbUseCompareOption | -1 | Uses option compare |
vbBinaryCompare | 0 | 二进制比较 |
vbTextCompare | 1 | 字符串比较 |
vbDatabaseCompare | 2 | 在数据库基础上比较 |
比如:
InStr(1, "abcde", "cd") 返回值是3
InStr("abcde", "cd") 返回值是3
InStr(6, "abcdeabcde", "cd") 返回值是8
8.2 Split(expression[, delimiter[, limit[, compare]]])
返回一个下标从零开始的一维数组,它包含指定数目的子字符串
使用Split切分后,用(UBound(mut) - LBound(mut) + 1)获取该数组的个数
9. 获取工作表使用的最大行数
Worksheet.UsedRange 属性
已用范围包含曾经使用过的任何单元格。例如,如果单元格“A1”包含一个值,随后您删除了该值,则单元格“A1”被视为已用。在这种情况下,UsedRange 属性将返回一个包含单元格“A1”的范围。在Excel2007中则只包含有存储值或有格式设置的单元格。
下面的代码示例使用 UsedRange 属性选择工作表上所使用的单元格的范围。该示例首先将当前工作表上 A1 至 C3 的单元格范围设置为值 23。如果该工作表可见,则该示例使用 UsedRange 属性选择所使用的单元格的
Private Sub SelectUsedRange()
Me.Activate()
Me.Range("A1", "C3").Value2 = 23
If Me.Visible = Excel.XlSheetVisibility.xlSheetVisible Then
Me.UsedRange.Select()
End If
End Sub
判断一个工作表是否为空或取得工作表已使用区域的行、列数:
Worksheet.UsedRange 是工作表的使用到的最大范围,直接使用UsedRange的属性:
Worksheets(1).UsedRange.Row ' 起始行
Worksheets(1).UsedRange.Column ' 起始列
Worksheets(1).UsedRange.Rows.Count ' 行数
Worksheets(1).UsedRange.Columns.Count ' 列数
Range.CurrentRegion 属性
当前的区域是由任意组合的空行和空列所包围的范围。此属性不适用于受保护的工作表。
(被填充的单元格块,包括当前被选中的一个单元格或者多个单元格。该区域延伸到各个方向上第一个碰到的空行或者空列)
关于CurrentRegion和UsedRange的困惑
CurrentRegion和UsedRange是很有用的,但是遇到一些极端情况,可能不那么如人意
set a = activesheet.cells.currentregion
set b= activesheet.usedrange
对于下图中的情况,除了C1:C3,A3:B3,A4外的所有格子为空(没有任何内容和格式),A4仅仅是加了特殊格式对于上述定义 a 为A1 b为A1:C4
但是我希望数据清单的范围是A1:C3 用usedrange挺好,就是怕有时候不经意在本来的数据清单的周围作了一些操作,而没有彻底清除,这样usedrange就不是想要的数据范围,进而导致程序出错或程序结果输出不理想 怎么有效地解决这个问题呢
currentregion只的是连续单元格组成的矩形区域,除了边界的单元格,一般单元格有8个相邻单元格,(下图中红线区域)
usedrange是当前工作表已经使用的单元格组成的矩形区域,设置格式也属于已经使用(下图中的兰线区域)
这两个区域有时相同,有时不同,本图中,二者结果不同的原因在于黄色区域是空白的
Range.End(xlup)
Sub GetMaxRow()
Dim MaxRow As Long
MaxRow = Me.Cells(1048576, 1).End(xlUp).Row
MsgBox MaxRow
End Sub
这一程序返回工作表中最后一个包含非空内容的单元格所在的行号,而不管这一单元格与Me.Cells(1,1)之间是否有包含空白内容的单元格。而且这一方法将跳过或者说忽略被隐藏的单元格,比如,数据表有连续的50行,如果第48到50行隐藏了,则这一程序只返回47。
补救方法:
MaxRow = Application.Evaluate("=MAX((A1:A1048576<>"""")*ROW(1:1048576))") '数组公式
如果表A列中没有空行也可以:
MaxRow = Application.WorksheetFunction.CountA(Me.Columns(1))
Worksheet.Rows 属性
10. 数学函数
sgn: 符号判断,值为-1,0,1
abs: 绝对值
Atn: 反正弦
其他:
结束程序:
End
调试程序:
Debug.Print myRange.Row & ", " & myRange.Column。立即窗口可通过(View菜单或Ctrl+G实现)。
代码换行符:
函数换行
Function IsSheetExist(shname As String, _
name As String)
Function IsSheetExist(shname As String _
, name As String)
字符串换行
"(" _
+ .Cells(i, 1).Value + "," _
+ .Cells(i, 2).Value + ",'" _
+ .Cells(i, 3).Value + "'," _
+ .Cells(i, 4).Value + ")"
注意:下划线前一定要有空格
全局变量:
Public ar as integer
如果是常量:Public Const ar as integer = 2
如果是变量,则在某个过程中赋值。
数组:
Dim intArray(10, 10, 10) As Integer
ReDim Preserve intArray(10, 10, 20)
ReDim Preserve intArray(10, 10, 15)
ReDim intArray(10, 10, 10)