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 属性

Private Sub DisplayRowCount() MsgBox("This worksheet contains " & _ Me.Rows.Count.ToString() & " rows.")End Sub

 

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)