VBA程式設計教學網站
VBA程式設計資料庫，各種基本概念與應用範例的代碼大全集，幫助新手的入門教學，可依照類別查詢語法，會適當添加註解說明，歡迎直接複製貼上使用。
目錄
運算子基本語法
Sub 加減乘除計算1()
Debug.Print 1 + 2 - 3 * 4 / 5 '0.6,先乘除後加減
Debug.Print 1 + (2 - 3) * 4 / 5 '0.2,括號優先順序
End Sub
Sub 特殊數學符號2()
Debug.Print 2 ^ 10 ' 1024 ,次方
Debug.Print 50 / 3 ' 16.6666666666667 ,除
Debug.Print 50 \ 3 '16,被除數,除數,商數,餘數
Debug.Print 3 Mod 2 '1,餘數
Debug.Print 5 Mod 2.4 '1,四捨五入為2
Debug.Print 5 Mod 2.6 '2,四捨五入為3
Debug.Print 5 Mod 2.5 '1,四捨五入失敗
Debug.Print 3.5 Mod 2 '0,四捨五入成功
End Sub
Sub 大小比較運算子3()
Debug.Print 1 = 2 'False,相等
Debug.Print 1 > 2 'False,大於
Debug.Print 1 >= 2 'False,大於等於
Debug.Print 1 <> 2 'True,不等於
Debug.Print 1 <> Empty 'True,Empty為空白
End Sub
Sub 物件對象相等4()
Set A = Sheets("工作表1")
Set B = 工作表1
Debug.Print A Is B 'True,相同工作表對象
'Debug.Print 1 Is 2 '型態不符合
End Sub
Sub Like模糊比對5()
Debug.Print "ABC" Like "*C" 'True,不限字串長度
Debug.Print "ABC" Like "?B?" 'True,限定字串長度
Debug.Print "B2B" Like "B#B" 'True,必須是數字
Debug.Print "B2B" Like "[A-Z]#B" 'True,必須英文字母
End Sub
Sub 邏輯關係判斷6()
Debug.Print 1 > 2 And 2 > 1 'False,同時為真
Debug.Print 1 > 2 Or 2 > 1 'True,至少一個為真
Debug.Print 1 > 2 Xor 2 > 1 'True,只能一個為真
Debug.Print (1 = 1 Xor 2 = 2) 'False,只能一個為真
Debug.Print Not (1 > 2 Or 2 > 1) 'False,真假互換
End Sub
Sub 數值文字串連7()
Debug.Print 123 + 456 ' 579 ,數值相加
Debug.Print 123 & 456 '123456,視為文字串連
Debug.Print "123" & "456" '123456,文字串連
Debug.Print "ABC" + "CDE" 'ABCCDE,視為文字串連
Debug.Print "ABC" & "CDE" 'ABCCDE,文字串連符號
End Sub
Application對象
Sub 取消提醒視窗()
'避免程式刪除工作表時Excel跳出確認視窗，全程自動化
Application.DisplayAlerts = False
暫存工作表.Delete
Application.DisplayAlerts = True
End Sub
Call副程序用法
Sub 儲存格作為參數()
Dim R As Range
Set R = 工作表1.[A1]
Call 子程序(R)
End Sub
Sub 子程序(R As Range)
Debug.Print R.Value
End Sub
Sub 工作表作為參數()
Dim S As Worksheet
Set S = 工作表1
Call 子程序2(S)
End Sub
Sub 子程序2(S As Worksheet)
Debug.Print S.Name
End Sub
活頁簿對象
Sub 工作表另存新檔()
'絕對路徑(特定位置)
ActiveSheet.Copy
With ActiveWorkbook
.SaveAs "D:\Test.xlsx"
.Close savechanges:=True
End With
'相對路徑(同一資料夾內)
ActiveSheet.Copy
With ActiveWorkbook
.SaveAs ThisWorkbook.Path & "\Test.xlsx"
.Close savechanges:=True
End With
End Sub
判斷活頁簿開啟
Sub 判斷活頁簿開啟1()
'錯誤9,陣列索引超出範圍(未開啟檔案)
Set W = Workbooks("活頁簿1.xlsx")
End Sub
Sub 判斷活頁簿開啟2()
'集合迴圈正向檢查是否開啟
For Each W In Workbooks
If W.Name = "活頁簿1.xlsx" Then Debug.Print "Yes"
Next W
End Sub
Sub 判斷活頁簿開啟3()
'錯誤機制反向驗證是否開啟
On Error Resume Next
Set W = Workbooks("活頁簿1.xlsx")
If Err.Number = 9 Then Debug.Print "No"
On Error GoTo 0
End Sub
工作表對象
Sub 刪除特定欄列()
'刪除列
With ActiveSheet
.Rows(9).Delete
.Rows("7:8").Delete
.Cells(6, 1).EntireRow.Delete
.Range("1:2,4:5").Delete
End With
'刪除欄
With ActiveSheet
.Columns(9).Delete
.Columns("G:H").Delete
.Cells(1, 6).EntireColumn.Delete
.Range("A:B,D:E").Delete
End With
'快速刪除空白列
With ActiveSheet
.Columns(1).SpecialCells(xlCellTypeBlanks).EntireRow.Delete
End With
End Sub
Sub 四種方法引用工作表()
N1 = Sheets(1).[A1] 'Index索引位置
N2 = Sheets("表2").[A1] '工作表名稱
N3 = 工作表3.[A1] 'VBA CodeName
ActiveSheet.[A1] = N1 + N2 + N3 '目前工作表
End Sub
多工作表合併列印
Sub 單一工作表列印()
ActiveSheet.PrintPreview
End Sub
Sub 多工作表同時列印()
Sheets(Array("工作表1", "工作表2")).PrintPreview
End Sub
Sub 特定工作表列印()
For Each S In Sheets
If S.Name Like "*月" Then S.Select Replace:=False
Next S
ActiveWindow.SelectedSheets.PrintPreview
End Sub
UsedRange三種用法
Sub UsedRange用法1()
With ActiveSheet
Debug.Print .UsedRange.Address '目前範圍
Debug.Print .UsedRange.Rows.Count '有多少列
Debug.Print .UsedRange.Columns.Count '有多少欄
End With
End Sub
Sub UsedRange用法2()
With ActiveSheet '清除工作表範圍
.Rows("12:1048576").Delete
.Columns("W:XFD").Delete
.UsedRange '重定位使用範圍
Debug.Print .UsedRange.Address
End With
End Sub
Sub UsedRange用法3()
'工作表公式值化
With ActiveSheet
.UsedRange = .UsedRange.Value
End With
End Sub
儲存格對象
Sub 儲存格定位方法()
'Resize變更目前範圍
Debug.Print [A1].Resize(1, 3).Address '$A$1:$C$1
'Offset移動目前範圍
Debug.Print [A1].Offset(1, 3).Address '$D$2
'End快速移動位置
Debug.Print [A1048576].End(xlUp).Address '$A$1
End Sub
儲存格輸入公式
Sub 五種輸入公式方法()
'方法1：輸入文字轉公式
[A1] = "=TODAY()"
'方法2：使用Range.Formula
[A2].Formula = "=TODAY()"
'方法3：WorksheetFunction
Debug.Print Application.WorksheetFunction.Sum(Range("A:A"))
'方法4：Evaluate評估函數
Debug.Print Evaluate("TODAY()")
'方法5：簡化的引用符號
Debug.Print [TODAY()]
End Sub
下拉選單三種方法
Sub 下拉選單三種方法()
'直接建立選單
[A1].Validation.Add Type:=xlValidateList, Formula1:="A,B"
'儲存格參照選單
[A2].Validation.Add Type:=xlValidateList, Formula1:="=C1:C2"
'程式陣列選單
A = [{"A","B"}]
[A3].Validation.Add Type:=xlValidateList, Formula1:=Join(A, ",")
End Sub
錯誤處理機制
Sub 錯誤處理1_錯誤程式()
'無此儲存格
[ZZZ1048578].Select '此處需要物件
End Sub
Sub 錯誤處理2_Resume_Next()
On Error Resume Next '錯了就錯了吧
[ZZZ1048578].Select
MsgBox "無差別跳過錯誤！"
End Sub
Sub 錯誤處理3_O_Error_Goto_0()
On Error Resume Next
[ZZZ1048578].Select
MsgBox "錯誤狀態1：" & Err.Number '424錯誤
On Error GoTo 0
MsgBox "錯誤狀態2：" & Err.Number '錯誤為0已清空
End Sub
Sub 錯誤處理4_O_Error_Goto_Lable()
On Error GoTo E '跳到指定位置
[ZZZ1048578].Select
Exit Sub '沒錯誤提前結束程式
E:
MsgBox "出現錯誤了！"
End Sub
檔案或資料夾是否存在
Sub 檔案或資料夾是否存在()
'一、Dir函數確認檔案存在
F = ThisWorkbook.Path & "\活頁簿1.xlsx"
Debug.Print Len(Dir(F)) '存在則長度不是0
'二、Dir函數確認檔案存在 (要加vbDirectory)
P = ThisWorkbook.Path & "\Test"
Debug.Print Len(Dir(P, vbDirectory))
'三、引用Windows檔案總管確認檔案存在
Set O = CreateObject("Scripting.FileSystemObject")
Debug.Print O.FileExists(P2)
'四、Windows組件確認資料夾存在 (記得不用拉掉)
Debug.Print O.folderexists(P)
Set O = Nothing
End Sub
刪除工作表操作
Sub 刪除工作表操作()
'刪除特定工作表
Sheets("工作表2").Delete
'刪除分散多工作表
Application.DisplayAlerts = False
Sheets(Array("工作表1", "工作表2")).Delete
Application.DisplayAlerts = ture
'集合工作表刪除
For Each S In ThisWorkbook.Sheets
If S.Index > ActiveSheet.Index Then
Application.DisplayAlerts = False
S.Delete
Application.DisplayAlerts = ture
End If
Next S
End Sub
三個基本MsgBox用法
Sub 簡單提示訊息()
MsgBox "這是訊息視窗"
End Sub
Sub 訊息標題及說明()
MsgBox prompt:="這是提示文字", _
Title:="這是視窗標題"
End Sub
Sub 是或否提示視窗()
M = MsgBox(prompt:="這是提示文字", _
Buttons:=vbYesNo + vbInformation + vbDefaultButton2, _
Title:="這是視窗標題")
If M = vbYes Then
MsgBox "按是的時候...！"
Else
MsgBox "按否的時候...！"
End If
'If U = vbNo Then Exit Sub
End Sub
FileDialog取得檔案路徑
Sub 取得檔案路徑1()
F = Application.FileDialog(3).Show
Debug.Print F
'有選取檔案是「-1」，取消是「0」
End Sub
Sub 取得檔案路徑2()
F = Application.FileDialog(3).Show
Debug.Print CBool(F) '轉換為真假布林值
'有選取檔案是「True」，取消是「False」
'0轉換成布林值是False，其他都是True
'布林值轉換，False是0，True是-1
End Sub
Sub 取得檔案路徑3()
If Application.FileDialog(3).Show Then
Debug.Print "已選取"
Else
Debug.Print "已取消"
End If
End Sub
Sub 取得檔案路徑4()
With Application.FileDialog(1)
If .Show Then
Debug.Print "已選取"
Else
Debug.Print "已取消"
End If
End With
End Sub
Sub 取得檔案路徑5()
With Application.FileDialog(1)
If .Show Then Debug.Print .SelectedItems(1)
End With
End Sub
Sub 取得檔案路徑6()
With Application.FileDialog(1)
With .Filters
.Clear
.Add "Excel檔案(xlsx)", "*.xlsx"
End With
If .Show Then Debug.Print .SelectedItems(1)
End With
End Sub
陣列宣告與賦值
Sub 數列宣告與賦值()
'Dim A(2) '預設為Variant型態
Dim A(2) As String
A(0) = 0: A(1) = 1: A(2) = 2
Debug.Print Join(A) '0 1 3
End Sub
Sub 初始陣列固定編號()
Dim A(1 To 3) '明確陣列編號
'Dim A(2) '設定不符錯誤
A(1) = 1: A(2) = 2: A(3) = 3
Debug.Print Join(A) '0 1 3
End Sub
Sub 不同資料型態陣列()
Dim A(3) 'Variant可容納不同資料類型
A(1) = 1: A(2) = "2": A(3) = True
'A(0)未定義預設為空白
Debug.Print Join(A) ' 1 2 True
End Sub
Sub Array與Evaluate陣列()
'Excel Evaluate一維陣列
A3 = [{"A","B"}]
Debug.Print A3(1) 'A
'Excel Evaluate二維陣列
A4 = [{"A","B";1,2}]
Debug.Print A4(2, 1) '1
'VBA Array一維陣列
A1 = Array("A", "B")
Debug.Print A1(0) 'A
'VBA Array二維陣列
A2 = Array(Array("A", 1), Array("B", 2))
Debug.Print A2(1)(1) '2
End Sub
變數設定陣列
Sub 變數設定陣列1()
'錯，陣列空間必須是常數運算式
N = 10
Dim A(1 To N)
End Sub
Sub 變數設定陣列2()
'對，Const固定變數也是常數
Const N = 10
Dim A(1 To N)
Debug.Print UBound(A) '10
End Sub
Sub 變數設定陣列3()
'可，動態陣列Redim固定陣列
N = 10
Dim A(): ReDim A(10)
Debug.Print UBound(A) '10
End Sub
ReDim陣列調整
Sub ReDim陣列調整1()
A = Array("A", "B", "C")
ReDim A(1) '錯：不正確的ReDim
End Sub
Sub ReDim陣列調整2()
Dim A() '動態陣列才能ReDim
A = Array("A", "B", "C")
ReDim A(2) 'ReDim後預設清空
Debug.Print Join(A) '每個都是空白
End Sub
Sub ReDim陣列調整3()
Dim A()
A = Array("A", "B", "C")
ReDim Preserve A(1) '保留原值
Debug.Print Join(A) 'A B
End Sub
Sub ReDim陣列調整4()
'Dim A() As Integer '型態不符合
Dim A() As Variant
A = Array(1, 2, 3)
ReDim Preserve A(5) '多的空間為預設值
Debug.Print Join(A, ",") '1,2,3,,,
End Sub
Sub ReDim陣列調整5()
Dim A() As Variant
For i = 1 To 3
ReDim Preserve A(1 To i)
A(i) = i
Next i
Debug.Print Join(A, ",") '1,2,3
End Sub
Sub ReDim陣列調整6()
Dim A()
N = [A1].CurrentRegion.Rows.Count
ReDim A(1 To N)
For i = 1 To N
A(i) = Cells(i, "A")
Next i
Debug.Print Join(A, ",")
End Sub
基本Select選擇語句
Sub 基本Select選擇語句()
X = 2
Select Case X
Case 1: Debug.Print "S"
Case 2: Debug.Print "L"
End Select '單一數值：L
Select Case X
Case 1 To 10: Debug.Print "S"
Case Is >= 11: Debug.Print "M"
End Select '數值區間：S
X = "L"
Select Case X
Case "S": Debug.Print "小"
Case "L": Debug.Print "大"
End Select '文字變數：大
End Sub
