VBA｜正確使用過程和自訂函數

過程是一個VBA語句塊，包含在聲明語句（Function、Sub、Get和Set）和匹配的End聲明中。

VBA中的所有可執行語句都必須位於某個過程內。可以將整個應用程度編寫為單個大的過程，但如果將它分解為多個較小的過程，代碼就更容易閱讀和理解。

1 VBA過程類型

1.1 VBA子過程：用於執行代碼後不返回值的情況。它們以關鍵字Sub開頭，並以關鍵字End Sub結束。在Excel中錄製的宏就是這種過程。

1.2 Function函數過程：用於執行代碼後返回計算結果的情況。它們以關鍵字Function開頭，以關鍵字End Function結束。使用Function函數過程可創建Excel的擴展函數。

1.3 Property過程：用於自訂對象。使用屬性過程可設置和獲取物件屬性的值，

或者設置對另外一個物件的引用。

2 VBA子過程與Function函數過程的區別

2.1 Sub子過程不能返回值，而Function函數過程可以返回一個值，因此可以像Excel內建函式一樣在運算式中使用Function函數。

2.2 Sub過程可作為Excel中的宏來調用，而Function函數不會出現在“選擇宏”對話方塊中，如果要在工作表中調用Function函數，則可以像使用Excel內建函式一樣使用該函數。

2.3 在VBA中， Sub過程可作為獨立的基本語句調用，而Function函數通常作為運算式的一部分。

3 Sub過程結構

[Private | Public | Friend] [Static] Sub 過程名 [(參數列表)]

[語句序列1]

[Exit Sub]

[語句序列2]

End Sub

如：

Sub 手工創建Sub過程()

MsgBox "這是手工輸入代碼創建的Sub過程！"

End Sub

4 Function函數的語法結構

[Private | Public | Friend] [Static] Function 函數名 [(參數清單)] [As 返回類型]

[語句序列1]

[函數名=運算式1]

[Exit Function]

[語句序列2]

[函數名=運算式2]

End Sub

如：

Function fTest1(a As Integer, b As Integer) As Integer

Dim t As Integer

Randomize

If a > b Then

t = a

a = b

b = t

End If

fTest1 = Int(Rnd * (b - a)) + a

End Function

5 Sub子程序呼叫

5.1 用Call語句調用

Call 過程名(過程參數列表) ‘沒有參數，

可以寫成：Call 過程名

5.2 將過程作為一個語句

Call Test(a,b)

或

Call Test a, b

6 調用Function函數過程

6.1 在工作表的公式中調用

“公式”選項卡→“插入函數”→在”或選擇類別“選擇框內選擇”用戶定義“，即可看到自訂的函數，如下：

6.2 在VBA代碼中調用

在VBA代碼中，可以像VBA內建函式一樣調用這種使用者自訂的Function函數。

Sub 生成亂數()

Dim R As Integer, l As Integer, u As Integer

l = Val(InputBox("請輸入亂數的下限：", "設置下限", 1))

u = Val(InputBox("請輸入亂數的上限：", "設置上限", 100))

R = fTest1(l, u)

MsgBox "生成的亂數為：" & R

End Sub

7 過程參數的形參與實參結合的方式

7.1 按位置結合

Function fTest1(a As Integer, b As Integer) As Integer

...

End Function

Call fTest1(1,100)

7.2 按具名引數方式結合

Call fTest1(a:=1,b:=100) '兩個參數的位置可以隨意

7.3 按位置和名稱混合結合參數

Call fTest1(1,b:=100)

8 過程參數傳遞方式（傳值或傳位址）

在VBA中，實參可通過傳值和傳位址兩種方式將資料傳遞給形參。

定義過程時，在形參的前面添加ByVal關鍵字，則該參數就按傳值方式傳遞；否則就按傳位址（預設）方式傳遞。

8.1 按傳值方式傳遞參數

Sub 傳值測試(ByVal a As Integer)

a = a + 1

Debug.Print "子過程中的變數A=" & a

End Sub

Sub 調用傳值測試()

Dim b As Integer

b = 3

Debug.Print "主程序中變數B=" & b

傳值測試 b

Debug.Print "主程序中變數B=" & b

End Sub

上述代碼在“立即視窗”中的顯示結果：

主程序中變數B=3

子過程中的變數A=4

主程序中變數B=3

由上面的結果可知，值並沒有真正傳遞過去。

8.2 按傳位址方式傳遞參數

Sub 傳位址測試(ByRef a As Integer)

a = a + 1

Debug.Print "子過程中的變數A=" & a

End Sub

Sub 調用傳地址過程()

Dim b As Integer

b = 3

Debug.Print "主程序中變數B=" & b

傳地址測試 b

Debug.Print "主程序中變數B=" & b

End Sub

上述代碼在“立即視窗”中的顯示結果：

主程序中變數B=3

子過程中的變數A=4

主程序中變數B=4

9 陣列作為參數

Sub 求最大數(a() As Integer)

Dim i As Integer, max As Integer

max = a(LBound(a))

For i = LBound(a) To UBound(a)

If a(i) > max Then max = a(i)

Debug.Print "最大數:" & max

End Sub

Sub 測試求最大數()

Dim MyArray(5) As Integer, i As Integer

For i = 0 To 5

MyArray(i) = i * 2

求最大數 MyArray()

End Sub

10 設置可選參數

“可選參數”在程序定義中由關鍵字Optional指示：

Sub 可選參數(strName As String, strSex As String, Optional ID)

With Worksheets("sheet3")

.Range("A2") = strName

.Range("B2") = strSex

If Not IsMissing(ID) Then

.Range("C2") = ID

End If

End With

End Sub

Public Sub 調用可選參數過程1()

可選參數 "wwu", "male"

End Sub

Public Sub 調用可選參數過程1()

可選參數 "wwu", "male", "2012"

End Sub

11 設置可變參數

“可變參數”在程序定義中由關鍵字ParamArray和一個Variant陣列定義：

Sub MySum(intTotal As Integer, ParamArray intNum())

Dim i As Integer, j As Integer

For i = LBound(intNum) To UBound(intNum)

intTotal = intTotal + intNum(i)

End Sub

Sub 調用可變參數()

Dim i As Integer

MySum i, 1, 2, 3, 4, 5, 6, 7, 8

Debug.Print i

End Sub

12 過程的遞迴呼叫

“遞迴”過程是指調用自身的過程。在遞迴呼叫中，一個過程執行的某一步要用到它自身的上一步（或上幾步）的結果。

Function fact(ByVal n As Integer) As Long

If n <= 1 Then

fact = 1

Else

fact = fact(n - 1) * n

End If

End Function

Sub test()

Debug.Print fact(8)

End Sub

13 常用過程實例

13.1 計算個人所得稅

個人所得稅稅率表(3500起征)
級數全月應納稅所得額稅率速算扣除數(元)1全月應納稅額不超過1500元3%02全月應納稅額超過1500元至4500元10%1053全月應納稅額超過4500元至9000元20%5554全月應納稅額超過9000元至35000元25%10055全月應納稅額超過35000元至55000元30%27556全月應納稅額超過55000元至80000元35%55057全月應納稅額超過80000元45%13505

Public Function taxes(curP As Currency, Optional dep As Integer = 3500)

Dim curT As Currency

curP = curP - dep '3500為扣除數

If curP > 0 Then

Select Case curP

Case Is <= 1500

curT = curP * 0.03

Case Is <= 4500

curT = curP * 0.1 - 105

Case Is <= 9000

curT = curP * 0.2 - 555

Case Is <= 35000

curT = curP * 0.25 - 1005

Case Is <= 55000

curT = curP * 0.3 - 2755

Case Is < 80000

curT = curP * 0.35 - 5505

Case Else

curT = curP * 0.45 - 13505

End Select

taxes = curT

Else

taxes = 0

End If

End Function

公式對應值=taxes(4000)15=taxes(7000)245=taxes(4000,5000)0=taxes(7000,5000)95

13.2 將數值轉換為表格的列號

Public Function NumtoCol(Numbers As Integer) As String

Dim i1 As Integer, i2 As Integer, i3 As Integer

Dim s1 As String, s2 As String, s3 As String

i2 = Numbers 26

i3 = i2 26 '第3位

i2 = i2 Mod 26 '第2位

i1 = Numbers Mod 26 '第1位

If i2 > 0 And i1 = 0 Then

i1 = 26

i2 = i2 - 1

End If

If i3 > 0 And i2 = 0 Then

i2 = 26

i3 = i3 - 1

End If

s3 = Chr(i3 + 64)

s2 = Chr(i2 + 64)

s1 = Chr(i1 + 64)

If s3 = "@" Then

If s2 = "@" Then

NumtoCol = s1

Else

NumtoCol = s2 & s1

End If

Else

NumtoCol = s3 & s2 & s1

End If

End Function

Sub 顯示列號()

With Worksheets("sheet1")

.Activate

.Range("AZ1").Select

End With

MsgBox Selection.Column

End Sub

Sub 測試顯示列號()

Dim intCol As Integer

intCol = Val(InputBox("請輸入列號（1~16384）："))

If intCol < 1 Or intCol > 16384 Then

MsgBox "輸入的資料超過範圍，請重新輸入！"

Exit Sub

End If

MsgBox "列號：" & intCol & "，對應的字母為：" & NumtoCol(intCol)

End Sub

13.3 大寫金額轉換函數

Function CapsMoney(curMoney As Currency) As String '轉換中文大寫金額函數

Dim curMoney1 As Long

Dim i1 As Long '保存整數部分(元部分)

Dim i2 As Integer '保存十分位元(角部分)

Dim i3 As Integer '保存百分位(分部分)

Dim s1 As String, s2 As String, s3 As String '保存轉換後的字串

curMoney1 = Round(curMoney * 100) '將金額擴大100倍,並進行四捨五入

i1 = Int(curMoney1 / 100) '獲取元部分

i2 = Int(curMoney1 / 10) - i1 * 10 '獲取角部分

i3 = curMoney1 - i1 * 100 - i2 * 10 '獲取分部分

s1 = Application.WorksheetFunction.Text(i1, "[dbnum2]")

'將元部分轉為中文大寫

s2 = Application.WorksheetFunction.Text(i2, "[dbnum2]")

'將角部分轉為中文大寫

s3 = Application.WorksheetFunction.Text(i3, "[dbnum2]")

'將分部分轉為中文大寫

s1 = s1 & "元" '整數部分

If i3 <> 0 And i2 <> 0 Then '分和角都不為0

s1 = s1 & s2 & "角" & s3 & "分"

If i1 = 0 Then '元部分為0

s1 = s2 & "角" & s3 & "分"

End If

If i3 = 0 And i2 <> 0 Then '分為0,角不為0

s1 = s1 & s2 & "角整"

If i1 = 0 Then '元部分為0

s1 = s2 & "角整"

End If

If i3 <> 0 And i2 = 0 Then '分不為0,角為0

s1 = s1 & s2 & s3 & "分"

If i1 = 0 Then '元為0

s1 = s3 & "分"

End If

If Right(s1, 1) = "元" Then s1 = s1 & "整" '為"元"後加上一個"整"字

CapsMoney = s1

End Function

－End－

i1 = Int(curMoney1 / 100) '獲取元部分

i2 = Int(curMoney1 / 10) - i1 * 10 '獲取角部分

i3 = curMoney1 - i1 * 100 - i2 * 10 '獲取分部分

s1 = Application.WorksheetFunction.Text(i1, "[dbnum2]")

'將元部分轉為中文大寫

s2 = Application.WorksheetFunction.Text(i2, "[dbnum2]")

'將角部分轉為中文大寫

s3 = Application.WorksheetFunction.Text(i3, "[dbnum2]")

'將分部分轉為中文大寫

s1 = s1 & "元" '整數部分

If i3 <> 0 And i2 <> 0 Then '分和角都不為0

s1 = s1 & s2 & "角" & s3 & "分"

If i1 = 0 Then '元部分為0

s1 = s2 & "角" & s3 & "分"

End If

If i3 = 0 And i2 <> 0 Then '分為0,角不為0

s1 = s1 & s2 & "角整"

If i1 = 0 Then '元部分為0

s1 = s2 & "角整"

End If

If i3 <> 0 And i2 = 0 Then '分不為0,角為0

s1 = s1 & s2 & s3 & "分"

If i1 = 0 Then '元為0

s1 = s3 & "分"

End If

If Right(s1, 1) = "元" Then s1 = s1 & "整" '為"元"後加上一個"整"字

CapsMoney = s1

End Function

－End－