自定義函數選
附代碼注釋
By 藍橋玄霜
我們平時在工作表單元格的公式中常常使用函數，Excel自帶的常用的函數多達300多個，功能強大，豐富多彩，博大精深。在Excel內置函數和擴展函數中有十多個應用領域的函數，如數學與三角函數、統計函數、文本和數據函數、查找和引用函數、數據庫函數、財務函數、日期和時間函數、信息函數、工程函數和宏表函數等等。
但是我們每個人還可能有各種各樣的問題而不能直接應用這些函數得到解決，於是Excel也提供了VBA可以讓我們自己編一個自定義函數來解決自己特定的需求。以下挑選一些自定義函數，由簡到繁，附以代碼注釋，供大家參考。
第1例折扣函數
一、題目：
要求編寫一個當銷售數量大於等於100時，售價打九折的計算折扣的自定義函數。
二、代碼：
Function Zekou(sul, jiag) As Double If sul>=100 Then Zekou =sul*jiag*0.1 Else Zekou =0 EndIf Zekou =Application.Round(Zekou,2) End Function
三、代碼詳解
1、Function Zekou(sul, jiag) As Double ：自定義函數的開始語句。
自定義函數總是以Function開頭，以End Function語句結束。自定義函數的代碼一定要放在標准模塊里面。
Zekou是函數名，名字可取一個較短的描述信名稱，這樣容易記憶。如sul數量和jiag價格，這里用的是拼音字母。函數后括號里的兩個變量叫做函數的參數。兩個參數都沒有顯式聲明數據類型，都是可變型數據類型variant。AS Double 表示函數返回值的數據類型是雙精度浮點型數據。
2、If sul>=100 Then 如果sul（數量）大於等於100，那么
這是標准的If…Then…Else判斷語句，意思是如果第一個條件成立，或者說滿足了第一個條件，那么執行Then以后的語句；否則執行Else以后的語句。
3、Zekou =sul*jiag*0.1 折扣＝數量×價格×0.1
4、Else 否則執行下面的語句，
5、Zekou = 0 折扣＝0，即數量小於100時，不打折扣。
6、Zekou =Application.Round(Zekou,2) 這里用了工作表的Round函數，返回一個數值，該數值是按照指定的小數位數進行四舍五入運算的結果。這里是按照2位小數進行四舍五入運算的折扣數值。
四、自定義函數用法
B2=450，C2＝100.00，D2＝Zekou(B2,C2) ‘返回4500.00
如圖 -1所示。
圖 -1 折扣函數用法
第2例兩點之間距離的自定義函數
一、題目：
要求編寫已知同一平面上兩點的坐標值，求兩點之間距離的自定義函數。
二、代碼：
Function dist(x1, y1, x2, y2) dist = Sqr((x2 - x1) ^ 2 + (y2 - y1) ^ 2) End Function
三、代碼詳解
1、Function dist(x1, y1, x2, y2) ：自定義函數的開始語句。
自定義函數名稱為dist，參數是兩點的坐標值x1、y1、x2、y2。
2、dist = Sqr((x2 - x1) ^ 2 + (y2 - y1) ^ 2) ：
這是一個求兩點間距離的公式，x坐標值差的平方與y坐標值差的平方之和的平方根就是兩點之間的距離。其中Sqr是VBA函數，返回一個 Double（雙精度數據），指定參數的平方根。
四、自定義函數用法
B2、B3單元格是點1的坐標值，D2、D3單元格是點2的坐標值，兩點之間的距離為C5＝dist(B2,B3,D2,D3) ‘返回156792
如圖 -2所示。
圖 -2 dist函數的用法
第3例十進制角度轉化為度分秒的自定義函數
一、題目：
要求編寫把一個十進制的角度，轉化為角的度分秒形式的自定義函數。
二、代碼：
Function dfm(angle3) '度轉化為度分秒 If angle3 < 0 Then deg1 = -Int(Abs(angle3)) Else deg1 = Int(angle3) End If min1 = (Abs(angle3) - Abs(deg1)) * 60 min2 = Int(min1) sec1 = Int((min1 - min2) * 60) dfm = deg1 & " °" & min2 & " '" & sec1 & " """ End Function
三、代碼詳解
1、Function dfm(angle3) ：自定義函數的開始語句。
自定義函數名稱為dfm，度分秒的拼音首字母，參數是angle3。
2、If angle3 < 0 Then ：
如果角度小於0，那么執行下面的語句，否則執行else后面的語句。
3、deg1 = -Int(Abs(angle3)) ：
這句用了兩個VBA函數，先是絕對值函數Abs，對負的角度取其絕對值，然后是取整函數Int，取角度的整數，加上-（負）以后賦值給變量deg1（整數度）。這里為什么要先用絕對值函數Abs呢？因為如果直接對負數取整，就會產生錯誤，如-36，直接對負數取整得到的是-37，而不是-36。
4、deg1 = Int(angle3) ：
如果角度是正的，只需要用取整函數Int，取角度的整數，賦值給變量deg1。
5、min1 = (Abs(angle3) - Abs(deg1)) * 60 ：
把角度的絕對值減去度絕對值的差乘以60，得到的值賦給變量min1（小數分）。
6、min2 = Int(min1) ：
把分取整的值賦給變量min2（整數分）。
7、sec1 = Int((min1 - min2) * 60) ：
把小數分減去整數分的差取整后乘以60，得到的值賦給變量sec1（整數秒）。
8、dfm = deg1 & " °" & min2 & " '" & sec1 & " """ ：
用字符連接運算符&把整數度整數分整數秒，中間加上度分秒的數學符號連接起來所形成的字符串賦給函數dfm。
四、自定義函數用法
A2、A3單元格的值是十進制的角度值，B2＝dfm(A2) ‘返回65°19’17” ，B3＝dfm(A3) ‘返回-36°41’7”
如圖 -3所示。
圖 -3 dfm函數的用法
第4例個人所得稅自定義函數
一、題目：
要求編寫一個計算個人所得稅的自定義函數。
二、代碼：
Function grsds(ysr, Optional qzd=2000) As Single Dim suil As Single, sukousu As Single, ynse As Single ynse = ysr - qzd Select Case ynse Case 0 To 500 suil = 0.05: sukousu = 0 Case 501 To 2000 suil = 0.1: sukousu = 25 Case 2001 To 5000 suil = 0.15: sukousu = 125 Case 5001 To 20000 suil = 0.2: sukousu = 375 Case 20001 To 40000 suil = 0.25: sukousu = 1375 Case 40001 To 60000 suil = 0.3: sukousu = 3375 Case 60001 To 80000 suil = 0.35: sukousu = 6375 Case 60001 To 100000 suil = 0.4: sukousu = 10375 Case Else suil = 0.45: sukousu = 15375 End Select If ynse <= 0 Then grsds = 0 Else grsds = Round(ynse * suil - sukousu, 2) End If End Function
三、代碼詳解
1、Function grsds(ysr, Optional qzd=2000) As Single：自定義函數的開始語句。
以Function開始，grsds是函數名，名字可任意取名，這里用了個人所得稅各字的拼音首字母，其它變量也是如此，如月收入ysr和起征點qzd。函數后括號里的兩個變量叫做函數的參數，在變量前加有Optional的表示是可選的參數，即可以用也可以不用它，這里＝2000表示該變量的默認值為2000，即如果不用它，變量qzd就＝2000。
AS Single 表示變量都聲明為單精度浮點型變量。Single（單精度浮點型）變量存儲為 32 位（4 個字節）浮點數值的形式，它的范圍在負數的時候是從 -3.402823E38 到 -1.401298E-45，而在正數的時候是從 1.401298E-45 到 3.402823E38。Single 的類型聲明字符為感嘆號 (!)。
2、Dim suil As Single, sukousu As Single, ynse As Single：三個變量都聲明為單精度浮點型變量。其中suil代表（稅率）、sukousu代表（速扣數）、ynse代表（應納稅額）。
3、ynse = ysr - qzd：把月收入（ysr)-起征點（qzd）的值賦給變量應納稅額（ynse）。由於qzd變量可選而且有默認值2000，所以如果公式中省略該參數，該參數就等於2000。
4、Select Case ynse和End Select：是一組判斷語句的一對開頭和結束語句。Ynse就是判斷的條件。Select Case與If…Then…Else判斷語句很相似，但是前者允許在許多的條件值這種選擇。你可以有任意數量的Case行，並且在每行上可包含多個值，還可以使用To子句來包含一個值范圍。比如下面的Case 0 To 500語句。
5、Case 0 To 500：如果應納稅額（ynse）的值在0～500之間的話，就執行下面的語句。如果應納稅額（ynse）的值不在0～500之間的話，就不執行下面的語句7而依次執行其它的Case語句。
6、suil = 0.05: sukousu = 0 ：如稅率＝0.05，速扣數＝0。接着執行End Select語句退出判斷語句。直接執行If ynse <= 0 Then語句。
7、其它的Case語句相同。最后一個Case Else語句表示如果上面所有的條件都不符合（也就是應納稅額大於100000時）那么稅率 = 0.45: 速扣數 = 15375，退出判斷語句。
8、If ynse <= 0 Then ：這是標准的If…Then…Else判斷語句，如果應納稅額小於等於0的話，那么。
9、grsds = 0 ：那么個人所得稅＝0。否則
10、grsds = Round(ynse * suil - sukousu, 2) ：個人所得稅＝應納稅額×稅率-速扣數。這里用了Round函數，返回一個數值，該數值是按照指定的小數位數進行四舍五入運算的結果。這里是按照2位小數進行四舍五入運算的個人所得稅數值。
四、自定義函數用法
A2=4500，B2＝grsds(A2) ‘返回250
A3=6000，B3＝grsds(A3,) ‘返回475
A4=8000，B4＝grsds(A3,2000) ‘返回825
如圖 -4所示。
圖 -4 個人所得稅函數用法
第5例直角三角形未知邊邊長函數
一、題目：
要求編寫一個已知直角三角形兩條邊的邊長求另一條未知邊邊長的自定義函數。
二、代碼：
Function bc (Optional short1, Optional short2, Optional longside) If Not (IsMissing(short1)) And Not (IsMissing(short2)) Then bc = Sqr(short1 ^ 2 + short2 ^ 2) ElseIf Not (IsMissing(short1)) And Not (IsMissing(longside)) Then bc = Sqr(longside ^ 2 - short1 ^ 2) ElseIf Not (IsMissing(short2)) And Not (IsMissing(longside)) Then bc = Sqr(longside ^ 2 - short2 ^ 2) Else bc = "需要有兩條已知的邊。" End If End Function
三、代碼詳解
1、Function bc (Optional short1, Optional short2, Optional longside) ：自定義函數的開始語句。
自定義函數總是以Function開頭，以End Function語句結束。
這里三個變量都是可選參數，實際上必須有兩個參數。代碼中會判斷引用的參數是短邊1還是短邊2，或者是長邊，然后進行計算。
2、If Not (IsMissing(short1)) And Not (IsMissing(short2)) Then ：
這是標准的If…Then…Else判斷語句，意思是如果有短邊1並且有短邊2，那么執行下面的語句，其中IsMissing是VBA函數，該函數返回一個 Boolean（布爾）值，Boolean（布爾）值有兩個：True（真）和False（假）。指出一個可選的 Variant（變體型） 參數是否已經傳遞給過程，如果傳遞給過程了，則函數返回False（假），反之函數返回True（真）。在 (IsMissing(short1))前面加Not邏輯運算符，則返回一個邏輯非，即如果有參數1，IsMissing(short1)返回False（假），加了Not以后返回了True（真）。我們平常說的“不假”，也就是“真”了。
3、bc = Sqr(short1 ^ 2 + short2 ^ 2) ：
計算公式是短邊1的平方+短邊2的平方的和再開平方。這里用了Sqr函數，它也是一個VBA函數，返回指定參數的平方根。
4、ElseIf Not (IsMissing(short1)) And Not (IsMissing(longside)) Then ：
如果第一個條件不滿足，但是有短邊1並且有長邊，那么執行下面的語句。
5、bc = Sqr(longside ^ 2 – short1 ^ 2) ：
計算公式是長邊的平方-短邊1的平方的差再開平方。
6、ElseIf Not (IsMissing(short2)) And Not (IsMissing(longside)) Then ：
如果第二個條件也不滿足，但是有短邊2並且有長邊，那么執行下面的語句。
7、bc = Sqr(longside ^ 2 – short1 ^ 2) ：
計算公式是長邊的平方-短邊2的平方的差再開平方。
8、Else ：
如果以上條件都不滿足，那么執行下面的語句。
9、bc = "需要有兩條已知的邊。" ：
把一個字符串返回給函數bc。
四、自定義函數用法
A1、A2是邊長，A1=26.36，A2＝30.24，B3＝bc(A1,A2,) ‘返回40.12 注意：這里省略了第3個參數長邊；
B4＝bc(A1,,A2) ‘返回14.82 注意：這里用了第3個參數長邊，省略了第2個參數短邊2。
B5＝bc(,A1,A2) ‘返回14.82注意：這里用了第3個參數長邊，省略了第1個參數短邊1。
B6＝bc(A1,,) ‘返回"需要有兩條已知的邊。" 注意：省略了2個參數。
如圖 -5所示。
圖 -5 bc函數用法
第6例兩直線交點坐標的自定義函數
一、題目：
要求編寫已知兩條直線的直線方程，求兩條直線交點的坐標的自定義函數。
二、代碼：
Function jiaox1(coea1, coeb1, coec1, coea2, coeb2, coec2) jiaox1 = -(coec1 * coeb2 - coec2 * coeb1) / (coea1 * coeb2 - coea2 * coeb1) End Function Function jiaoy1(coea1, coeb1, coec1, coea2, coeb2, coec2) jiaoy1 = -(coea1 * coec2 - coea2 * coec1) / (coea1 * coeb2 - coea2 * coeb1) End Function
三、代碼詳解
1、Function jiaox1(coea1, coeb1, coec1, coea2, coeb2, coec2) ：自定義函數的開始語句。自定義函數名稱為jiaox1，參數分別是直線方程的系數值coea1、coeb1、coec1、coea2、coeb2、coec2。
2、jiaox1 = -(coec1 * coeb2 - coec2 * coeb1) / (coea1 * coeb2 - coea2 * coeb1) ：
交點的X坐標jiaox1，右邊為交點的X坐標的計算公式。
交點的Y坐標jiaoy1的計算公式類似。
四、自定義函數用法
直線的標准方程為：Ax+By+C=0
直線1的方程為：y=2x+1 coea1=2; coeb1=-1; coec1=1
直線2的方程為：y=-x+4 coea2=-1; coeb2=-1; coec2=4
A2、D2、G2單元格是直線1方程的系數，A4、D4、G4單元格是直線2方程的系數，兩直線交點的X1坐標為C7＝jiaox1(A2,D2,G2,A4,D4,G4) ‘返回1
兩直線交點的Y1坐標為C7＝jiaoy1(A2,D2,G2,A4,D4,G4) ‘返回3
如圖 -6所示。
圖 -6 jiaoy1函數的用法
第7例兩直線夾角的自定義函數
一、題目：
要求編寫一個已知兩條直線上的四個點的坐標，求兩直線的夾角的自定義函數。
二、代碼：
Function jiaj(x1, y1, x2, y2, x3, y3, x4, y4) '兩直線的夾角 '2009-5-20修改 '直線1逆時針轉向直線2之夾角 If (x1 = x2 And y1 = y2) Or (x3 = x4 And y3 = y4) Then jiaj = "不是兩條直線！": Exit Function If x1 = x2 Then '直線1平行Y軸 If x3 = x4 Then '直線2平行Y軸 jiaj = "兩條直線平行不相交！": Exit Function Else kkk2 = (y3 - y4) / (x3 - x4) jiaj = Application.Degrees(Atn(kkk2)) If jiaj < 0 Then jiaj = 90 + jiaj Else jiaj = 90 - jiaj End If End If ElseIf x3 = x4 Then kkk1 = (y1 - y2) / (x1 - x2) jiaj = Application.Degrees(Atn(kkk1)) jiaj = 90 - jiaj Else kkk1 = (y1 - y2) / (x1 - x2): kkk2 = (y3 - y4) / (x3 - x4) If (1 + kkk1 * kkk2) <> 0 Then jiaj = (kkk2 - kkk1) / (1 + kkk1 * kkk2) jiaj = Application.Degrees(Atn(jiaj)) If jiaj < 0 Then jiaj = 180 + jiaj Else jiaj = 180 - jiaj End If End If End If jiaj = dfm(jiaj) End Function
三、代碼詳解
1、Function jiaj(x1, y1, x2, y2, x3, y3, x4, y4) ：自定義函數的開始語句。
自定義函數名稱為jiaj，八個參數分別是4個點的坐標值。
2、If (x1 = x2 And y1 = y2) Or (x3 = x4 And y3 = y4) Then jiaj = "不是兩條直線！": Exit Function：如果每一條直線的x、y坐標值兩兩相等，那么這是兩個點，不是直線了；所以jiaj返回“不是兩條直線！”，並退出。
3、If x1 = x2 Then ：下面對直線1的x坐標值進行一些判斷，如果x1=x2，則直線1垂直x軸；那么執行下面的代碼；
4、If x3 = x4 Then ：再對直線2的x坐標值進行判斷，如果x3=x4，則直線2也垂直x軸；如果直線2垂直x軸，那么執行下面的代碼；
5、jiaj = "兩條直線平行不相交！": Exit Function ：返回信息並退出函數。
6、kkk2 = (y3 - y4) / (x3 - x4) ：如果直線2不垂直x軸，那么求得直線2的斜率kkk2；
7、jiaj = Application.Degrees(Atn(kkk2)) ：
這里運用了兩個函數，一個是VBA函數Atn，反正切函數；另一個是Excel的函數Degrees，將弧度轉為十進制的度。Excel的函數在VBA中不能直接引用，必須在函數前面加Application對象；而VBA函數Atn可以直接運用。Atn(kkk2)返回夾角的弧度值，再用Degrees函數將弧度轉為十進制的度。這時的變量jiaj的值還不是兩直線十進制的夾角，而是直線2與x軸的十進制夾角；
8、If jiaj < 0 Then ：如果夾角小於0那么執行下面的代碼；這里實際是判斷直線2的斜率是否小於0，
9、jiaj = 90 + jiaj ：如果夾角小於0那么兩直線十進制的夾角就等於90+jiaj；
10、jiaj = 90 - jiaj ：否則兩直線十進制的夾角就等於90-jiaj；
11、下面的判斷與上面的類似，不再多說了；
12、kkk1 = (y1 - y2) / (x1 - x2): kkk2 = (y3 - y4) / (x3 - x4) ：
變量kkk1和kkk2分別是兩條直線的斜率，計算公式等於y1-y2的值除以x1-x2的值。kkk2前面的“:”表示后面是另一個語句，相當於另起一行。
13、If (1 + kkk1 * kkk2) <> 0 Then ：
如果1+kkk1*kkk2的值不等於0，那么執行下面的語句；
14、jiaj = (kkk2 - kkk1) / (1 + kkk1 * kkk2) ：
這里變量jiaj的值等於上述的公式計算的值，還不是兩直線的夾角；
15、If jiaj < 0 Then jiaj = 180 + jiaj ：
如果jiaj小於0，那么jiaj就等於180+jiaj。兩條直線的夾角的大小在0～180°之間，自定義函數jiaj是以x1，y1，x2，y2兩點組成的直線1逆時針轉到以x3，y3，x4，y4兩點組成的直線2所形成的夾角。
16、jiaj = dfm(jiaj) ：
這里引用了另一個自定義函數dfm，目的是把十進制的度轉換成度分秒的形式顯示出來。自定義函數dfm見第3例。只要自定義函數dfm在同一個工作簿中，就可以象VBA函數一樣直接引用。
四、自定義函數用法
參數說明：x1,y1 直線1上點1的x，y坐標值；x2,y2是直線1上點2的x,y坐標值；x3,y3 直線2上點3的x，y坐標值；x4,y4是直線2上點4的x,y坐標值
使用示例：
點1(35260,192410) 點2(83210,341690)
點3(-6405722,-3115123) 點4(-6413459,-3131370)
B2、B3、D2、D3、F2、F3、H2、H3單元格的值分別是各坐標值。
B7＝jiaj(B2,B3,D2,D3,F2,F3,H2,H3)，返回夾角為172°20’35”
如圖 -7所示。
圖 -7 jiaj函數的用法
第8例可見單元格求和函數
一、題目：
要求編寫一個只對可見單元格求和的自定義函數。
二、代碼：
Function kjdygSUM(rng As Variant) Dim cel As Range For Each cel In rng If cel.EntireRow.Hidden = False Then kjdygSUM = kjdygSUM + cel.Value End If Next cel End Function
三、代碼詳解
1、Function kjdygSUM(rng As Variant) ：自定義函數的開始語句。
自定義函數名稱為kjdygSum，不受大小寫的影響。
變量rng聲明為變體型數據類型Variant。Variant 數據類型是所有沒被顯式聲明（用如 Dim、Private、Public 或 Static等語句）為其他類型變量的數據類型。Variant 是一種特殊的數據類型，除了定長 String 數據及用戶定義類型外，可以包含任何種類的數據。
2、Dim cel As Range ：
聲明變量cel為單元格區域。
3、For Each cel In rng ：
這是又一種循環語句，For Each是For …Next的一個變異，而且是VBA獨有的，它適合於處理數組和對象集合。意思是在區域rng中的每一個單元格cel，一個個循環執行下面的語句。
4、If cel.EntireRow.Hidden = False Then ：
如果單元格所在的行是可見的話，那么執行下面的語句。
5、kjdygSUM = kjdygSUM + cel.Value ：
可見單元格的和就等於可見單元格數值的累加。
四、自定義函數用法
A1～A12中每個單元格的值都＝10，其中第3、5、7、10行隱藏了。B13＝kjdygsum(A1:A12) ‘返回80
如圖 -8所示。
圖 -8 kjdygsum函數的用法
第9例單元格區域不重復值的自定義函數
一、題目：
要求編寫已知單元格區域，求區域中不重復值的自定義函數。
二、代碼：
Function Bcfz(rng As Range) Dim d As Object, rCell As Range Set d = CreateObject("Scripting.Dictionary") On Error Resume Next For Each rCell In rng If Not d.exists(rCell.Text) Then If rCell <> "" Then d.Add rCell.Text, 1 End If End If Next rCell Bcfz = d.keys Set d = Nothing End Function
三、代碼詳解
1，Function Bcfz(rng As Range) ：自定義函數的開始語句。自定義函數名稱為Bcfz，是“不重復值”的拼音首字母，便於記憶；參數是單元格區域rng。
2、Dim d As Object, rCell As Range ：
聲明變量d為一般對象，rCell為區域對象。Object也是一種數據類型，涉及的范圍很廣，這里不再深入探討，只要了解一下即可。
3、Set d = CreateObject("Scripting.Dictionary") ：
這里使用Set語句把字典對象賦值給對象變量d，CreateObject函數，創建並返回一個對 ActiveX 對象的引用。（注：Dictionary對象是VBScript語言（Visual Basic程序設計語言的最新家族成員）中的一個對象。如果不用CreateObject函數，要在應用程序中使用Dictionary對象，就必須利用Reference（引用）對話框增加一個項目級的引用到Scripting Runtime Library（腳本運行時庫）。）
4、On Error Resume Next ：
On Error Resume Next語句是VBA中的錯誤處理程序語句，這里的意思是如果語句執行中發生了錯誤，就執行下一條語句，以免代碼顯示出錯信息而中斷。
5、For Each rCell In rng ：
For Each…Next循環語句，對區域對象rng中的每個單元格rCell對象作循環。
6、If Not d.exists(rCell.Text) Then ：
如果字典d里面不存在單元格rCell的內容，那么執行下面的語句。
7、If rCell <> "" Then ：
為了使空值不進入字典d中，所以再增加一個判斷語句：如果單元格rCell不等於空，那么執行下面的語句。
8、d.Add rCell.Text, 1 ：
就把單元格rCell的內容作為關鍵字增加到字典中。
9、Bcfz = d.keys ：
把字典的關鍵字賦值給函數Bcfz返回，這里d.keys是一個數組。
10、Set d = Nothing ：
把變量d設置為Nothing，即取消字典對象與變量d的關聯。
四、自定義函數用法
Sub yy1()
Dim rng As Range ‘聲明變量rng為區域對象
Set rng = [a1:c10] ‘把A1到C10單元格區域賦值給變量rng
[d1].Resize(UBound(Bcfz(rng)) + 1, 1) = Application.Transpose(Bcfz(rng))
End Sub
最后一句代碼比較復雜，引用了帶參數rng的自定義函數Bcfz，Resize是單元格對象的屬性，調整指定區域的大小。返回 Range 對象，該對象代表調整后的區域。Ubound函數返回一個 Long 型數據，其值為指定的數組維可用的最大下標，這里的Bcfz函數返回的是以0為下標開始值的數組，如本例的數組下標從0～4，總數是5個，但是Ubound函數返回的最大下標是4，所以在Resize調整區域中要+1，表示有五行，另一個參數1表示一列，從前面[d1]單元格開始調整為五行一列，即[d1:d5]，把不重復值經過轉置后賦給它們。Transpose函數是Excel工作表函數，在VBA中使用時前面要加上Application對象。Transpose函數可以把行轉換成列。
把自定義函數和過程yy1的代碼輸入在模塊1里面，如圖 -9a所示；然后在工作表上使用窗體工具欄的按鈕控件做一個按鈕，把宏yy1指定給此按鈕，把按鈕名改為“不重復值”。現在只要點按此按鈕，就能在D1~D5單元格得到A1~C10單元格區域的不重復值了。如圖 -9b所示
圖 -9a 兩段代碼
圖 -9b 不重復值自定義函數的用法
第10例活動單元格加指定單元格內容批注的自定義函數
一、題目：
要求編寫一個可分別把指定單元格的內容作為批注寫入活動單元格的自定義函數。
如果活動單元格里面沒有批注就增加此批注；如果里面有批注就把批注修改為指定單元格的內容。
二、代碼：
Function pizhu(ParamArray Rngs() As Variant) Dim cel As Range, s$, singleArea,m% For m = LBound(Rngs) To UBound(Rngs) Set singleArea = Rngs(m) For Each cel In singleArea If cel <> "" Then s = s & cel.Value & vbCrLf End If Next cel Next m With ActiveCell If .Comment Is Nothing Then .AddComment Text:=s Else .Comment.Text Text:=s End If End With pizhu = "" End Function
三、代碼詳解
1，Function pizhu(ParamArray Rngs() As Variant) ：自定義函數的開始語句。自定義函數名稱為pizhu，是“批注”的拼音字母，便於記憶；參數是單元格區域,一個數組變量Rngs()。使用關鍵字ParmArray說明的參數可在調用時接受傳遞給它的任何個數的參數。這些參數被放在一個可變類型數組中。如果未使用Option Base語句，數組的下界為0。要注意的是ParmArray 只能用於參數表的最后一個參數。
2、Dim cel As Range, s$, singleArea,m% ：聲明變量cel為單元格區域對象，s為字符串數據類型，m為整型，為可變型數據類型。
3、For m = LBound(Rngs) To UBound(Rngs) ：
這是標准的For …Next循環語句，LBound和UBound是兩個VBA函數，可求得數組的下界和上界，下界默認為0。
4、Set singleArea = Rngs(m) ：
把單元格區域逐個賦值給變量singleArea。
5、For Each cel In singleArea ：
For Each…Next循環語句，對區域對象singleArea中的每個單元格cel對象作循環。
6、If cel <> "" Then ：如果cel單元格不為空，那么執行下面的語句。
7、s = s & cel.Value & vbCrLf ：把cel單元格的值加上換行符一起賦給變量s。第一次循環時，s為空值，以后隨着循環而把區域內所有單元格的值一起賦給變量s。
8、With ActiveCell ：使用With…..End With語句有三個優點：它可以減少代碼的輸入量；增加代碼的可讀性和改善代碼的執行效率。它為我們提供了十分簡便的對象引用手段。
9、If .Comment Is Nothing Then ：如果活動單元格沒有批注，那么執行下面的語句。
10、.AddComment Text:=s ：使用區域對象的增加批注屬性AddComment，批注文本等於變量s的值。
11、.Comment.Text Text:=s ：否則使用區域對象的批注屬性Comment，把原來的批注修改為新的文本等於變量s的值。
12、pizhu = "" ：函數返回一個空值。
四、自定義函數用法
例如A1、B2和C3單元格里面不為空，活動單元格為D5。在D5里輸入公式：=pizhu(A1,B2,C3)
或者輸入：＝pizhu(A1:F6)
如圖-10所示。
圖 -10 批注自定義函數的用法
第11例求字符串中符合范圍數的和的自定義函數
一、題目：
單元格中有漢字，英文，標點符號，數字，但是不含時間和日期，要求編寫一個字符串中滿足條件>＝10，<＝10^13數字的和的自定義函數。
二、代碼：
Function getl(R1 As Range) As Double Dim x%, temp$, Arr(), aa$, y%, temp1$ If R1.Count > 1 Then MsgBox "本代碼僅適用於一個單元格！": Exit Function For x = 1 To Len(R1) - 1 temp = Mid(R1, x, 1) If temp Like "[0-9,.]" Or (Asc(temp) <= -23623 And Asc(temp) >= -23632) Then aa = aa & temp Else aa = "": GoTo 100 End If For y = x + 1 To Len(R1) temp1 = Mid(R1, y, 1) If (temp1 Like "[0-9,.]" And aa <> "") Or (Asc(temp1) <= -23623 And Asc(temp1) >= -23632 And aa <> "") Then aa = aa & temp1 If y = Len(R1) Then r = r + 1 ReDim Preserve Arr(1 To r) Arr(r) = CDbl(aa) aa = "": x = y End If Else r = r + 1 ReDim Preserve Arr(1 To r) Arr(r) = CDbl(aa) aa = "" x = y: Exit For End If Next y 100: Next x For x = 1 To r If Arr(x) >= 10 And Arr(x) <= 10 ^ 13 Then getl = getl + Arr(x) End If Next x End Function
三、代碼詳解
1，Function getl(R1 As Range) As Double ：
自定義函數的開始語句。自定義函數名稱為getl，參數R1聲明為區域對象，函數返回值聲明為雙精度浮點數據類型。
2、Dim x%, temp$, Arr(), aa$, y%, temp1$ ：
聲明變量x為整型數據，temp、temp1和aa為字符串變量，Arr()為可變類型數組。
3、If R1.Count > 1 Then MsgBox "本代碼僅適用於一個單元格！“: Exit Function ：
如果單元格區域中單元格數目大於1，則信息框顯示”本代碼僅適用於一個單元格！“，然后退出結束函數。
4、For x = 1 To Len(R1) - 1 ：
循環語句x從1 到單元格字符串長度－1結束。
5、temp = Mid(R1, x, 1) ：
依次將從單元格字符串中取出一個字符，賦值給變量temp。
6、If temp Like "[0-9,.]" Or (Asc(temp) <= -23623 And Asc(temp) >= -23632) Then ：
如果變量temp 是0-9數字，是小數點”.” 或者這個字符的ASC碼小於等於-23623並且大於等於-23632，那么執行下面的語句。這個判斷語句是為了提取小數點和數字，運用了比較運算符Like，它的作用是比較兩個字符串的內容，當字符串的內容包含在樣板字符串中時，比較結果為True。”[0-9,.]”是樣板字符串，注意要有雙引號，數字必須按照升序顯示，中間用”-“連接。由於單元格里有雙字節數字存在，它們的ASC碼范圍在-23623和-23632之間，所以用了前后兩個判斷，只要滿足一個就執行下面的語句。
7、aa = aa & temp ：
把變量temp和變量aa連接形成新的字符串賦值給變量aa。如果數字是連續的，就可獲得一個完整的數字了。
8、aa = "": GoTo 100 ：
如果變量temp不是數字，則把空字符串賦給變量aa，接着執行第100句，判斷單元格中下一個字符。
9、For y = x+ 1 To Len(R1) ：
嵌套循環語句y從x+1 到單元格字符串長度結束，前一個字符是數字以后接着判斷下一個字符是不是數字。
后面3句與上述的5、6、7句一樣，只是變量是temp1。
10、If y = Len(R1) Then ：
如果變量y是單元格的最后一個數字，那么執行下面的語句。
11、r = r + 1 ：
變量r+1以后賦給變量r，相當於計數器一樣。
12、ReDim Preserve Arr(1 To r) ：
重新聲明動態數組Arr，大小從1到r，用了關鍵字 Preserve 可確保原來包含數據的數組中的任何數據都不會丟失。
13、Arr(r) = CDbl(aa) ：
把變量aa用CDbl函數轉換成雙精度浮點型數據以后賦給數組變量Arr。
14、aa = "": x = y ：
把把空字符串賦給變量aa，把y的值賦給變量x，進入第一個循環。
后面4句與上述的11～14句一樣，只是退出第二個循環。
15、For x = 1 To r ：
取出所有的數字以后，再一個循環語句x從1 到r結束。用來判斷這些數字是否符合條件並且計算那些符合條件的數字的和。
16、If Arr(x) >= 10 And Arr(x) <= 10 ^ 13 Then ：
判斷這些數字是否符合條件，如果數組變量Arr(x)大於等於10並且小於等於10的13次方的話，那么執行下面的求和語句。
17、getl = getl + Arr(x) ：
把數組變量Arr(x) 累加后賦給函數getl，完成整個函數過程。
四、自定義函數用法
例如A列單元格里面為包含數字的字符串，活動單元格為C2。在C2里輸入公式：=getl(A2) 如圖 -11所示。
圖 -11 getl自定義函數的用法