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)