電子表格VBA編程計(jì)算速成（4）| 第四章 電子表格計(jì)算編程
學(xué)會(huì)了自己編制函數(shù)，掌握了單元格和工作表的基本編程代碼和設(shè)置，就可以對(duì)您所需要的復(fù)雜專業(yè)項(xiàng)目進(jìn)行編程自動(dòng)化計(jì)算了。如果您對(duì)編程是一無(wú)所知的初學(xué)者，也許前面的自編函數(shù)還沒有完全看懂，這不要緊，下面介紹VB編程基本語(yǔ)法之后，自然就會(huì)清楚了；至于代碼，那都是系統(tǒng)命令，知道它的含義和用途，動(dòng)腦筋靈活用好它就可以了。
4.1 電子表格VB編程基本語(yǔ)法
ＶＢ編程計(jì)算是什么？簡(jiǎn)單說就是通過命名的變量、常量來(lái)存儲(chǔ)用于計(jì)算的數(shù)據(jù)，存儲(chǔ)和傳遞計(jì)算的中間或最后的結(jié)果；通過一系列的代碼語(yǔ)句來(lái)處理數(shù)據(jù)，輸出數(shù)據(jù)，從而完成計(jì)算任務(wù)。下面簡(jiǎn)明分述之：
4.1.1 變量和常量
一，標(biāo)識(shí)符（變量、常量、數(shù)據(jù)類型、過程、函數(shù)等）命名規(guī)則：
⑴字母開頭；
⑵不超過255個(gè)字符；
⑶只包含字母，數(shù)字，下劃線；
⑷不能用系統(tǒng)的保留字（42個(gè)關(guān)鍵字），即系統(tǒng)命令、語(yǔ)句、函數(shù)的固定標(biāo)識(shí)符。如：As，ByVai，Me，Set，F(xiàn)or，To等
VB中不區(qū)分字母大小寫。在命名時(shí)最好采用好記、又好理解的命名方式：一般用英語(yǔ)單詞或其縮寫加數(shù)字，下劃線；國(guó)人也可以用漢語(yǔ)簡(jiǎn)拼加數(shù)字，下劃線來(lái)命名，首字母一般大寫。
二，聲明變量
1. Dim語(yǔ)句：用于創(chuàng)建過程級(jí)變量，聲明變量的數(shù)據(jù)類型并分配存儲(chǔ)空間。
可以在一個(gè)語(yǔ)句中聲明幾個(gè)變量，但必須將每一個(gè)變量的數(shù)據(jù)類型包含進(jìn)來(lái)。如下語(yǔ)句中，變量 intX、intY、與 intZ 被聲明為 Integer 類型。
Dim intX As Integer, intY As Integer, intZ As Integer
而下面的語(yǔ)句中，變量 intX 與 intY 被聲明為 （缺省）Variant 類型 ；只有 intZ 被聲明為 Integer 類型。
Dim intX, intY, intZ As Integer
2. Public 語(yǔ)句：聲明公共模塊級(jí)別變量。公有變量可用于工程中的任何過程。
Public strName As String
如果公有變量是聲明于標(biāo)準(zhǔn)模塊或是類模塊中，則它也可以被任何引用到此公有變量所屬工程的工程中使用。
3. Private 語(yǔ)句：聲明私有的模塊級(jí)別變量。私有變量只可使用于同一模塊中的過程。
Private MyName As String
注意，在模塊級(jí)別中使用 Dim 語(yǔ)句與使用 Private 語(yǔ)句是相同的。不過使用 Private 語(yǔ)句可以更容易的讀取和解釋代碼。
4. Static 語(yǔ)句：聲明靜態(tài)變量。使用 Static 語(yǔ)句取代 Dim 語(yǔ)句時(shí)，所聲明的變量在每次調(diào)用時(shí)仍保留它原先的值。
三，聲明常數(shù)：可用如下格式聲明公用常數(shù)，數(shù)據(jù)類型也可用變量聲明字符%、&、!、#代表Integer（整型%）、Long（長(zhǎng)整型&）、Single（單精度型!）、Double（雙精度型#）。
Public Const M_SEC# = 206264.8 '1弧度=206264.8″
Public Const M_DEG# = 57.2957795130823 '1弧度=57.2957795130823°
Public Const M_RAD# = 1.74532925199433E-02 '1度=1.74532925199433E-02弧度
Public Const M_PI# = 3.14159265358979 'π=3.14159265358979
可以在一個(gè)語(yǔ)句中聲明數(shù)個(gè)常數(shù),但必須將每一個(gè)常數(shù)的數(shù)據(jù)類型包含進(jìn)來(lái)。如下面的語(yǔ)句中，常數(shù) conAge 和 conWage 被聲明為 Integer 類型。
Const conAge % = 34, conWage As Currency = 35000
四，聲明數(shù)組：數(shù)組的聲明方式和其它的變量是一樣的。
Dim MyArray(10, 10) As Integer
第一個(gè)參數(shù)代表的是行；而第二個(gè)參數(shù)代表的是列。
與其它變量的聲明一樣，除非指定一個(gè)數(shù)據(jù)類型給數(shù)組，否則聲明數(shù)組中元素的數(shù)據(jù)類型為Variant。為了盡可能使寫的代碼簡(jiǎn)潔明了，則要明確聲明的數(shù)組為某一種數(shù)據(jù)類型而非 Variant。
4.1.2 數(shù)據(jù)類型
1. Byte（字節(jié)型），1字節(jié)，0到255
2. Boolean（布爾型），2字節(jié)，True或False
3. Integer（整型%），2字節(jié)，-32,767到32,767
4. Long（長(zhǎng)整型&），4字節(jié)，-2,147,483,648到2,147,483,647
5. Currency（貨幣型），8字節(jié)，-922,337,203,685,477.5808到922,337,203,685,477.5807
6. Single（單精度型!），4字節(jié)，-3.402823E+38到-1.401298E-45；
1.401298E-45到3.402823E+38
7. Double（雙精度型#），8字節(jié)，-1.79769313486232E+308到-4.94065645841247E-324； 4.94065645841247E-324到1.79769313486232E+308
8. Date（日期型），8字節(jié)，100年1月1日到9999年12月31日
9. String（變長(zhǎng)字符串$），10字節(jié)，0到大約20億
10. String * length （定長(zhǎng)字符串），字符串長(zhǎng)度
11. Object（對(duì)象，4字節(jié)），任何對(duì)象引用
12. Variant（變體型，數(shù)字），16字節(jié)，任何數(shù)字值
13. Variant（變體型，數(shù)字16字節(jié)；字符22字節(jié)，任何字符串值
數(shù)據(jù)類型缺省為Variant。
4.1.3 運(yùn)算符與表達(dá)式
一，算術(shù)運(yùn)算符：+（加，也用于字符串拼接），-（減，也作為負(fù)號(hào)），*（乘），/（浮點(diǎn)數(shù)除），\（整數(shù)除），Mod（取模），^（乘方、開方），&（字符串拼接）
算術(shù)運(yùn)算符的優(yōu)先級(jí)為：^，-（負(fù)號(hào)），*、/、\、Mod，+、-，&。
在運(yùn)算表達(dá)式中，有括號(hào)，先算括號(hào)內(nèi)，有多層括號(hào)，內(nèi)層括號(hào)優(yōu)先。
二，關(guān)系運(yùn)算符：<（小于）,<=（小于等于）,>（大于）,>=（大于等于）,=（等于）,<>（不等于）
關(guān)系運(yùn)算符用來(lái)對(duì)兩個(gè)表達(dá)式的值進(jìn)行比較，結(jié)果是一個(gè)邏輯值真（True）或假（False）。
三，邏輯運(yùn)算符：
四，表達(dá)式的執(zhí)行順序：
1. 方式運(yùn)算
2. 算術(shù)運(yùn)算
3. 關(guān)系運(yùn)算
4. 邏輯運(yùn)算
5. 賦值運(yùn)算
4.1.4 流程控制語(yǔ)句
一，順序結(jié)構(gòu)語(yǔ)句
1. 賦值語(yǔ)句：把一個(gè)表達(dá)式的值賦給一個(gè)變量或者控件對(duì)象的一個(gè)屬性。語(yǔ)句格式為：
變量名＝表達(dá)式 或者 對(duì)象名. 屬性＝表達(dá)式
示例1：指定 InputBox 函數(shù)的返回值給變量
yourName。Sub Question()
Dim yourName As String
yourName = InputBox("What is your name?")
MsgBox "Your name is " & yourName
End Sub
示例2：設(shè)置對(duì)于活動(dòng)單元格 Font 對(duì)象的 Bold 屬性
ActiveCell.Font.Bold = True
2. 輸入輸出語(yǔ)句：
①InputBox 函數(shù)：
在一對(duì)話框中顯示提示，等待用戶輸入正文或按下按鈕，并返回包含文本框內(nèi)容的字符串。其語(yǔ)法：
InputBox(prompt[, title] [, default] [, xpos] [, ypos] [, helpfile, context])
Prompt必需的。對(duì)話框中的提示文本。prompt 的最大長(zhǎng)度大約是 1024 個(gè)字符，由所用字符的寬度決定。如果 prompt 包含多個(gè)行，則可在各行之間用回車符 (Chr(13))、換行符 (Chr(10)) 或回車換行符的組合 (Chr(13) & Chr(10)) 來(lái)分隔。
Title可選的。顯示對(duì)話框標(biāo)題欄中的文本。如果省略 title，則把應(yīng)用程序名放入標(biāo)題欄中。
Default可選的。顯示文本框中缺省的字符串表達(dá)式。如果省略 default，則文本框?yàn)榭铡?/font>
Xpos可選的。指定對(duì)話框的左邊與屏幕左邊的水平距離，數(shù)值表達(dá)式，成對(duì)出現(xiàn)。如果省略 xpos，則對(duì)話框會(huì)在水平方向居中。
Ypos可選的。指定對(duì)話框的上邊與屏幕上邊的距離，數(shù)值表達(dá)式，成對(duì)出現(xiàn)。如果省略 ypos，則對(duì)話框被放置在屏幕垂直方向距下邊大約三分之一的位置。
Helpfile可選的。識(shí)別幫助文件，用該文件為對(duì)話框提供上下文相關(guān)的幫助，字符串表達(dá)式。如果已提供 helpfile，則也必須提供 context。
Context可選的。指定給某個(gè)幫助主題的幫助上下文編號(hào)，數(shù)值表達(dá)式。如果已提供 context，則也必須要提供 helpfile。
說明
如果同時(shí)提供了 helpfile 與 context，用戶可以按 F1 (Windows) or HELP (Macintosh) 來(lái)查看與 context 相應(yīng)的幫助主題。某些主應(yīng)用程序，例如，Microsoft Excel，會(huì)在對(duì)話框中自動(dòng)添加一個(gè) Help 按鈕。如果用戶單擊 OK 或按下ENTER ，則 InputBox 函數(shù)返回文本框中的內(nèi)容。如果用戶單擊 Cancel，則此函數(shù)返回一個(gè)長(zhǎng)度為零的字符串 ("")。
注意：如果還要指定第一個(gè)命名參數(shù)以外的參數(shù)，則必須在表達(dá)式中使用 InputBox。如果要省略某些位置參數(shù)，則必須加入相應(yīng)的逗號(hào)分界符。
下面是獲取InputBox函數(shù)的返回值的賦值語(yǔ)句
Xzan% = InputBox("0,清空；1,→算表面積；2.寫入公式－10； 3,計(jì)算－100；4,計(jì)算－150；5,計(jì)算－200；6,計(jì)算－250；7,計(jì)算－300；8,計(jì)算－350；9.計(jì)算－400；10,刪除數(shù)據(jù)名…",”請(qǐng)選擇項(xiàng)目”)
② MsgBox 函數(shù)：
在對(duì)話框中顯示消息，等待用戶單擊按鈕，并返回一個(gè) Integer 告訴用戶單擊哪一個(gè)按鈕。
MsgBox(prompt[, buttons] [, title] [, helpfile, context])
Prompt 必需的。顯示在對(duì)話框中的消息文本。prompt 的最大長(zhǎng)度大約為 1024 個(gè)字符，由所用字符的寬度決定。如果 prompt 的內(nèi)容超過一行，則可以在每一行之間用回車符 (Chr(13))、換行符 (Chr(10)) 或是回車與換行符的組合 (Chr(13) & Chr(10)) 將各行分隔開來(lái)。
Buttons可選的。數(shù)值表達(dá)式是值的總和，指定顯示按鈕的數(shù)目及形式，使用的圖標(biāo)樣式，缺省按鈕是什么以及消息框的強(qiáng)制回應(yīng)等。如果省略，則 buttons 的缺省值為 0。
Title可選的。顯示對(duì)話框標(biāo)題欄中的文本。如果省略 title，則將應(yīng)用程序名放在標(biāo)題欄中。
Helpfile可選的。字符串表達(dá)式，識(shí)別用來(lái)向?qū)υ捒蛱峁┥舷挛南嚓P(guān)幫助的幫助文件。如果提供了 helpfile，則也必須提供 context。
Context可選的。識(shí)別幫助文件，用該文件為對(duì)話框提供上下文相關(guān)的幫助，字符串表達(dá)式。如果已提供 helpfile，則也必須提供 context。
buttons 參數(shù)常用設(shè)置值：
按鈕返回值常數(shù)：
說明
在提供了 helpfile 與 context 的時(shí)候，用戶可以按 F1(Windows) or HELP (Macintosh) 來(lái)查看與 context 相應(yīng)的幫助主題。像 Microsoft Excel 這樣一些主應(yīng)用程序也會(huì)在對(duì)話框中自動(dòng)添加一個(gè) Help 按鈕。
如果對(duì)話框顯示 Cancel 按鈕，則按下 ESC 鍵與單擊 Cancel 按鈕的效果相同。如果對(duì)話框中有 Help 按鈕，則對(duì)話框中提供有上下文相關(guān)的幫助。但是，直到其它按鈕中有一個(gè)被單擊之前，都不會(huì)返回任何值。
注意： 如果還要指定第一個(gè)命名參數(shù)以外的參數(shù)，則必須在表達(dá)式中使用 MsgBox。為了省略某些位置參數(shù)，必須加入相應(yīng)的逗號(hào)分界符。
二，分支結(jié)構(gòu)語(yǔ)句
當(dāng)要求有選擇地執(zhí)行指定操作時(shí)，采用條件分支程序結(jié)構(gòu)。
1. If...Then...Else 語(yǔ)句
根據(jù)給定條件的值，使用 If...Then...Else 語(yǔ)句運(yùn)行指定的語(yǔ)句或一個(gè)語(yǔ)句塊。If...Then...Else 語(yǔ)句可根據(jù)需要嵌套多級(jí)。然而，為了可讀性可能會(huì)使用 Select Case 語(yǔ)句而不使用多級(jí)嵌套的 If...Then...Else 語(yǔ)句。
① 如果條件為 True 則運(yùn)行語(yǔ)句
當(dāng)條件為 True 時(shí)，若只要執(zhí)行一個(gè)語(yǔ)句，則可以使用單行的 If...Then...Else 語(yǔ)法。下列的示例顯示了單行語(yǔ)法，省略了 Else 關(guān)鍵字：
Sub FixDate()
myDate = #2/13/95#
If myDate < Now Then myDate = Now
End Sub
為了運(yùn)行多行代碼，必須使用多行的語(yǔ)法。而此語(yǔ)法包含 End If 語(yǔ)句，如同下面示例所示：
Sub AlertUser(value as Long)
If value = 0 Then
AlertLabel.ForeColor = "Red"
AlertLabel.Font.Bold = True
AlertLabel.Font.Italic = True
End If
End Sub
② 如果條件為 True，運(yùn)行某些語(yǔ)句；條件為 False，運(yùn)行其它的語(yǔ)句
使用 If...Then...Else 語(yǔ)句可以定義兩個(gè)可執(zhí)行的語(yǔ)句塊：其中一個(gè)塊會(huì)在條件為True 時(shí)執(zhí)行；而另一個(gè)塊會(huì)在條件為 False 時(shí)執(zhí)行。
Sub AlertUser(value as Long)
If value = 0 Then
AlertLabel.ForeColor = vbRed
AlertLabel.Font.Bold = True
AlertLabel.Font.Italic = True
Else
AlertLabel.Forecolor = vbBlack
AlertLabel.Font.Bold = False
AlertLabel.Font.Italic = False
End If
End Sub
③ 如果第一個(gè)條件為 False 時(shí)，測(cè)試第二個(gè)條件
如果第一個(gè)條件為 False，則可以在 If...Then...Else 語(yǔ)句中加上 ElseIf 語(yǔ)句來(lái)測(cè)試第二個(gè)條件。例如，下列的函數(shù)過程根據(jù)工作分類來(lái)計(jì)算獎(jiǎng)金。如果所有 If 和 ElseIf 語(yǔ)句中條件都是 False，則會(huì)運(yùn)行跟在 Else 語(yǔ)句之后的語(yǔ)句。
Function Bonus(performance, salary)
If performance = 1 Then
Bonus = salary * 0.1
ElseIf performance = 2 Then
Bonus = salary * 0.09
ElseIf performance = 3 Then
Bonus = salary * 0.07
Else
Bonus = 0
End If
End Function
2. Select Case 語(yǔ)句
從一個(gè)條件設(shè)置中選擇某一分支。下面是一個(gè)專業(yè)計(jì)算過程，根據(jù)輸入框的輸入數(shù)字計(jì)算相應(yīng)的語(yǔ)句體。
Private Sub bmjjsButton1_Click()
Dim xzan As String
xzan = InputBox("0,清空；1,→地形點(diǎn)計(jì)算；2.寫入公式－10； 3,計(jì)算－100 ",”請(qǐng)選擇項(xiàng)目”)
If xzan = "" Then GoTo js
Select Case xzan
Case "0"
語(yǔ)句體（清空）
Case "1"
語(yǔ)句體（→地形點(diǎn)計(jì)算）
Case "2"
語(yǔ)句體（寫入公式－10）
Case "3"
語(yǔ)句體（計(jì)算－100）
End Select
js:
End Sub
請(qǐng)注意：每個(gè) Case 語(yǔ)句可以包含一個(gè)以上的值，一個(gè)值的范圍，或是一個(gè)值的組合以及比較運(yùn)算符。如果 Select Case 語(yǔ)句與Case 語(yǔ)句的任何值相匹配，則可選的 Case Else 語(yǔ)句運(yùn)行。
Function Bonus(performance, salary)
Select Case performance
Case 1
Bonus = salary * 0.1
Case 2, 3
Bonus = salary * 0.09
Case 4 To 6
Bonus = salary * 0.07
Case Is > 8
Bonus = 100
Case Else
Bonus = 0
End Select
End Function
3. 無(wú)條件轉(zhuǎn)移語(yǔ)句Goto bz（標(biāo)簽）
當(dāng)程序執(zhí)行到Goto bz語(yǔ)句時(shí)，會(huì)無(wú)條件轉(zhuǎn)到bz：標(biāo)志處，并繼續(xù)往下運(yùn)行。很好利用這一特性可解決多條件分支和循環(huán)的問題。如：
Public Hz_Button1()
Dim Hx as Integer
Dim Qh, Zh As Double
Sheet2.Activate
' ………………
Hx = 3
sh2:
If Cells(Hx, 1) = 0 Then GoTo js2
If Cells(Hx, 1) >= Qh And Cells(Hx, 1) <= Zh Then
Cells(Hx, 4).Select
With Selection.Interior
.ColorIndex = 36 '淡黃＝36
.Pattern = xlSolid
End With
' ………………
Hx = Hx + 1
GoTo sh2
ElseIf Cells(Hx, 1) < Qh Or Cells(Hx, 1) > Zh Then
Hx = Hx + 1
GoTo sh2
End If
js2:
' ………………
End Sub
4. 跳轉(zhuǎn)子程序語(yǔ)句GoSub...Return
當(dāng)程序執(zhí)行到GoSub bz語(yǔ)句時(shí)，會(huì)無(wú)條件轉(zhuǎn)到標(biāo)志bz開始的子程序，當(dāng)碰到第一個(gè) Return 語(yǔ)句時(shí)，程序就會(huì)返回到緊接在剛剛執(zhí)行的 GoSub 語(yǔ)句之后的語(yǔ)句繼續(xù)執(zhí)行。利用這一特性，我們可以將較長(zhǎng)的相同過程代碼，創(chuàng)建分開的過程，并使用 GoSub...Return 來(lái)調(diào)用，可以使程序更具結(jié)構(gòu)化。須注意的是，GoSub 和與之相應(yīng)的 Return 語(yǔ)句必須放在同一個(gè)過程中。如：
Sub GosubDemo()
Dim Num
' 請(qǐng)求用戶輸入一個(gè)數(shù)字。
Num = InputBox("Enter a positive number to be divided by 2.")
' 如果用戶輸入一個(gè)正整型，則使用子程序。
If Num > 0 Then GoSub zcx
Debug.Print Num
Exit Sub ' 使用 Exit 命令來(lái)避免錯(cuò)誤發(fā)生。
zcx：
Num = Num/2 ' 將數(shù)除以 2。
Return '' 將控制返回 GoSub 之后的語(yǔ)句。
End Sub
三，循環(huán)結(jié)構(gòu)語(yǔ)句
當(dāng)要求重復(fù)執(zhí)行一組操作時(shí)，采用循環(huán)程序結(jié)構(gòu)語(yǔ)句。其中有些循環(huán)重復(fù)執(zhí)行語(yǔ)句直到條件為 False；而有些循環(huán)重復(fù)執(zhí)行語(yǔ)句直到條件為 True。也有某些循環(huán)執(zhí)行一指定次數(shù)的語(yǔ)句或是集合中的每一個(gè)對(duì)象。
1. Do...Loop 語(yǔ)句
可以使用 Do...Loop 語(yǔ)句去運(yùn)行語(yǔ)句的塊，而它所用掉的時(shí)間是不確定的。當(dāng)條件為 True 或直到條件變成 True 時(shí)，此語(yǔ)句會(huì)一直重復(fù)。
① 直到條件為 True 時(shí)重復(fù)語(yǔ)句
當(dāng)使用 While 關(guān)鍵字去檢查 Do...Loop 語(yǔ)句中的條件時(shí)，可以有兩種方法。可以在進(jìn)入循環(huán)之前檢查條件式，也可以在循環(huán)至少運(yùn)行一次之后才檢查條件式。
在下面的 ChkFirstWhile 過程中，在進(jìn)入循環(huán)之前檢查條件。如果將 myNum 的值由 20 替換成 9，則循環(huán)中的語(yǔ)句將永遠(yuǎn)不會(huì)運(yùn)行。 在ChkLastWhile 過程中，在條件變成 False 之前循環(huán)中的語(yǔ)句只執(zhí)行一次。
Sub ChkFirstWhile()
counter = 0
myNum = 20
Do While myNum > 10
myNum = myNum - 1
counter = counter + 1
Loop
MsgBox "The loop made " & counter & " repetitions."
End Sub
Sub ChkLastWhile()
counter = 0
myNum = 9
Do
myNum = myNum - 1
counter = counter + 1
Loop While myNum > 10
MsgBox "The loop made " & counter & " repetitions."
End Sub
② 直到條件變成 True 才重復(fù)語(yǔ)句
當(dāng)使用 Until 關(guān)鍵字去檢查 Do...Loop 語(yǔ)句中的條件時(shí)，可以使用兩種方法?？梢栽谶M(jìn)入循環(huán)之前檢查條件（如同 ChkFirstUntil 過程所示），也可以在循環(huán)至少運(yùn)行一次之后才檢查條件（如同 ChkLastUntil 過程所示）。當(dāng)條件仍然為 False 時(shí)，循環(huán)繼續(xù)。
Sub ChkFirstUntil()
counter = 0
myNum = 20
Do Until myNum = 10
myNum = myNum - 1
counter = counter + 1
Loop
MsgBox "The loop made " & counter & " repetitions."
End Sub
Sub ChkLastUntil()
counter = 0
myNum = 1
Do
myNum = myNum + 1
counter = counter + 1
Loop Until myNum = 10
MsgBox "The loop made " & counter & " repetitions."
End Sub
③ 從循環(huán)內(nèi)退出 Do...Loop 語(yǔ)句
可以使用 Exit Do 語(yǔ)句來(lái)退出 Do...Loop 語(yǔ)句。例如，為了退出無(wú)窮循環(huán)，可以在 If...Then...Else 語(yǔ)句或是 Select Case 語(yǔ)句的 True 語(yǔ)句塊中使用 Exit Do 語(yǔ)句。如果條件為 False，則循環(huán)會(huì)象通常那樣運(yùn)行。
在下面的示例中，myNum 被賦予一個(gè)會(huì)造成無(wú)窮循環(huán)的值。而 If...Then...Else 語(yǔ)句會(huì)去檢查這個(gè)情況然后退出，以避免無(wú)窮循環(huán)。
Sub ExitExample()
counter = 0
myNum = 9
Do Until myNum = 10
myNum = myNum - 1
counter = counter + 1
If myNum < 10 Then Exit Do
Loop
MsgBox "The loop made " & counter & " repetitions."
End Sub
注意：可以按 ESC 或 CTRL+BREAK 鍵來(lái)終止無(wú)窮循環(huán)。
2. For...Next 語(yǔ)句
可以使用 For...Next 語(yǔ)句去重復(fù)一個(gè)語(yǔ)句塊，而它的次數(shù)的數(shù)字是指定的。For 循環(huán)使用一個(gè)計(jì)數(shù)變量，當(dāng)重復(fù)每個(gè)循環(huán)時(shí)它的值會(huì)增加或減少。
下面的過程會(huì)讓計(jì)算機(jī)發(fā)出嗶聲 50 次。For 語(yǔ)句會(huì)指定計(jì)數(shù)變量 x 的開始與結(jié)束值。Next 語(yǔ)句會(huì)將計(jì)數(shù)變量的值加 1。
Sub Beeps()
For x = 1 To 50
Beep
Next x
End Sub
使用 Step 關(guān)鍵字，可以由所指定的值增加或減少計(jì)數(shù)變量。在下面的示例中，計(jì)數(shù)變量 j 會(huì)在每次循環(huán)重復(fù)時(shí)加上 2。當(dāng)循環(huán)完成時(shí)，total 的值為 2、4、6、8 和 10 的總合。
Sub TwosTotal()
For j = 2 To 10 Step 2
total = total + j
Next j
MsgBox "The total is " & total
End Sub
為了減少計(jì)數(shù)變量的值，可以使用負(fù)的 Step 值。為了減少計(jì)數(shù)變量的值，必須指定一個(gè)小于開始值的結(jié)束值。在下面的示例中，計(jì)數(shù)變量 myNum 會(huì)在每次循環(huán)重復(fù)時(shí)減去 2。當(dāng)循環(huán)完成時(shí)，total 的值為 16、14、12、10、8、6、4 和 2 的總合。
Sub NewTotal()
For myNum = 16 To 2 Step -2
total = total + myNum
Next myNum
MsgBox "The total is " & total
End Sub
注意：在 Next 語(yǔ)句后面不必包含計(jì)數(shù)變量的名稱。上述的示例中，因?yàn)橐哂锌勺x性才加上計(jì)數(shù)變量的名稱。
可以在計(jì)數(shù)變量到達(dá)它的結(jié)束值之前，使用 Exit For 語(yǔ)句來(lái)退出 For...Next 語(yǔ)句。例如，當(dāng)錯(cuò)誤發(fā)生時(shí)，可以使用在 If...Then...Else 語(yǔ)句或是 Select Case 語(yǔ)句的 True 語(yǔ)句塊中的 Exit For 語(yǔ)句，它是專門用來(lái)檢查此錯(cuò)誤的。如果沒有錯(cuò)誤發(fā)生，則 If...Then...Else 語(yǔ)句的值為 False，循環(huán)會(huì)象預(yù)期那樣的運(yùn)行。
3. For Each...Next 語(yǔ)句
For Each...Next 語(yǔ)句會(huì)重復(fù)一個(gè)語(yǔ)句塊，而它是作用于集合中的每個(gè)對(duì)象或是數(shù)組中的每個(gè)元素。當(dāng)循環(huán)執(zhí)行一次則 Visual Basic 會(huì)自動(dòng)設(shè)置一個(gè)變量。例如，下面的過程會(huì)關(guān)閉所有的窗體，除了窗體包含的過程正在運(yùn)行以外。
Sub CloseForms()
For Each frm In Application.Forms
If frm.Caption <> Screen. ActiveForm.Caption Then frm.Close
Next
End Sub
下面的代碼會(huì)在數(shù)組的每個(gè)元素中循環(huán)，并且將每個(gè)值設(shè)置成它的索引變量 I 的值。
Dim TestArray(10) As Integer, I As Variant
For Each I In TestArray
TestArray(I) = I
Next I
對(duì)某范圍的單元格做循環(huán)
可以使用 For Each...Next 循環(huán)對(duì)某范圍的單元格做循環(huán)。下面的過程會(huì)對(duì)于 Sheet1 中的 A1:D10 范圍做循環(huán)，并將任何絕對(duì)值小于 0.01 的號(hào)碼設(shè)為 0。
Sub RoundToZero()
For Each myObject in myCollection
If Abs(myObject.Value) < 0.01 Then myObject.Value = 0
Next
End Sub
在完成前退出 For Each...Next 循環(huán)
可以使用 Exit For 語(yǔ)句來(lái)退出 For Each...Next 循環(huán)。例如，當(dāng)錯(cuò)誤發(fā)生時(shí)可以在 If...Then...Else 語(yǔ)句或是 Select Case 語(yǔ)句的 True 語(yǔ)句塊中使用 Exit For 語(yǔ)句，它是專門用來(lái)檢查此錯(cuò)誤的。如果沒有錯(cuò)誤發(fā)生，If...Then...Else 語(yǔ)句的值為 False，則循環(huán)會(huì)象預(yù)期那樣運(yùn)行。
下面的示例，測(cè)試在 A1:B5 范圍內(nèi)找出第一個(gè)不含數(shù)值的單元。如果有找到此類單元，則會(huì)有信息顯示并用 Exit For 語(yǔ)句退出循環(huán)。
Sub TestForNumbers()
For Each myObject In MyCollection
If IsNumeric(myObject.Value) = False Then
MsgBox "Object contains a non-numeric value."
Exit For
End If
Next c
End Sub
4. With 語(yǔ)句
With 語(yǔ)句是指定同一個(gè)對(duì)象（或?qū)傩裕┑囊幌盗杏脩舳x類型的簡(jiǎn)化格式。With 語(yǔ)句使過程運(yùn)行得更快并且?guī)椭苊夥磸?fù)的鍵入代碼。
下面的示例將某一范圍的單元格都填入 30，字體使用黑體格式，并將內(nèi)部單元格顏色設(shè)置成黃色。
Sub FormatRange()
With Worksheets("Sheet1").Range("A1:C10")
.Value = 30
.Font.Bold = True
.Interior.Color = RGB(255, 255, 0)
End With
End Sub
可以將 With 語(yǔ)句嵌套的使用，如此將更具有效率。下面的示例在 A1 這個(gè)存儲(chǔ)單元格中插入一個(gè)公式，然后格式化字體。
Sub MyInput()
With Workbooks("Book1").Worksheets("Sheet1").Cells(1, 1)
.Formula = "=SQRT(50)"
With .Font
.Name = "Arial"
.Bold = True
.Size = 8
End With
End With
End Sub
4.1.5 Sub 過程
Sub 過程是一系列由 Sub 和 End Sub 語(yǔ)句所包含起來(lái)的 Visual Basic 語(yǔ)句，它們會(huì)執(zhí)行動(dòng)作卻不能返回一個(gè)值。Sub 過程可有參數(shù)，例如常數(shù)、變量、或是表達(dá)式等來(lái)調(diào)用它。如果一個(gè) Sub 過程沒有參數(shù)，則它的 Sub 語(yǔ)句必須包含一個(gè)空的圓括號(hào)。下面 Sub 過程是4.3中的一部分，每一行都有注釋來(lái)解釋它的作用：
' 響應(yīng)地形點(diǎn)視距極座標(biāo)計(jì)算表“選擇按鈕”過程
‘聲明工作表1私有的過程dxdzbButton1_Click()…End Sub
Private Sub dxdzbButton1_Click()
Dim xzan As String ‘ 聲明變量xzan
Dim msg, style, title, response ‘ 聲明變量msg, style, title, response
Application.AskToUpdateLinks = False ‘ 取消Excel的更新鏈接
Sheet1.Visible = xlSheetVisible ‘ 設(shè)置Sheet1（“地形點(diǎn)”）可見
Sheet3.Visible = xlSheetVisible ‘ 設(shè)置Sheet3（“操作指南”）可見
Sheet2.Visible = xlSheetHidden ‘ 設(shè)置Sheet2（“表面積”）不可見
Sheet1.Activate ‘ 激活Sheet1
Range("J4").Select ‘ 選擇J4單元格
‘ 輸入公式"=COUNTA(R[1]C[-8]:R[396]C[-8])"，計(jì)算B5:B400有數(shù)字的單元格的數(shù)量
ActiveCell.FormulaR1C1 =
‘ 在K5單元格輸入公式，將點(diǎn)的坐標(biāo)數(shù)據(jù)轉(zhuǎn)換成cass的展點(diǎn)文件格式
Range("K5").Select
ActiveCell.FormulaR1C1 = "=IF(RC[-9]=0,0,RC[-9]&"",""&"",""&RC[-3]&"",""&RC[-4]&"",""&RC[-2])"
‘ 將K5單元格的公式自動(dòng)填充到K100
Range("K5").Select
Selection.AutoFill Destination:=Range("K5:K100"), Type:=xlFillDefault
‘ 在F2單元格輸入公式，自動(dòng)顯示系統(tǒng)日期
Range("F2").Select
ActiveCell.FormulaR1C1 = "=Today()"
‘ 設(shè)置隱藏工作表活動(dòng)窗口0值
ActiveWindow.DisplayZeros = False
‘ 卸載自編函數(shù)"新增測(cè)繪、工程、科學(xué)計(jì)算函數(shù)1.0"加載宏
AddIns("新增測(cè)繪、工程、科學(xué)計(jì)算函數(shù)1.0").Installed = False
‘ 選擇A5單元格
Range("A5").Select
ks: ‘ 表示開始的標(biāo)號(hào)，用于程序轉(zhuǎn)移的目標(biāo)
‘ 賦值語(yǔ)句，將InputBox()函數(shù)的返回值賦予變量xzan，InputBox()函數(shù)會(huì)出現(xiàn)一個(gè)標(biāo)題為”請(qǐng)選擇項(xiàng)目”（不含“”）的輸入框，依據(jù)選擇項(xiàng)目輸入相應(yīng)的數(shù)字
xzan = InputBox("0,→清空；1,→算表面積；2.寫入公式－10； 3,計(jì)算－100", ”請(qǐng)選擇項(xiàng)目”)
‘ 條件語(yǔ)句，當(dāng)xzan = ""，程序轉(zhuǎn)移到標(biāo)號(hào)js，否則執(zhí)行下面語(yǔ)句
If xzan = "" Then GoTo js
‘ Select Case xzan ……End Select語(yǔ)句，依據(jù)xzan選擇Case "i"
Select Case xzan
‘ 當(dāng)在輸入框輸入0時(shí)，程序執(zhí)行Case "0"下的語(yǔ)句體
Case "0"
msg = "確實(shí)要清空嗎？" ‘ 賦值語(yǔ)句
style = vbYesNo + vbInformation + vbDefaultButton2 ‘ 賦值語(yǔ)句
title = "提示" ‘ 賦值語(yǔ)句
= MsgBox(msg, style, title) ‘ 賦值語(yǔ)句，response＝ MsgBox(msg, style, title)函數(shù)（提示框）返回值
‘ 條件語(yǔ)句，response = vbYes（在提示框單擊“是”）執(zhí)行Then后的語(yǔ)句體：清除A5:I400區(qū)域內(nèi)容
If response = vbYes Then
Range("A5:I400").Select
Selection.ClearContents
Range("A5").Select
‘ 條件語(yǔ)句，否則response = vbNo，則結(jié)束條件語(yǔ)句
ElseIf response = vbNo Then
End If
‘ 當(dāng)在輸入框輸入1時(shí)，程序執(zhí)行Case "1"下的語(yǔ)句體
Case "1"
…………
…………
'結(jié)束 Sub 過程
End Sub
當(dāng)上述過程是響應(yīng)地形點(diǎn)視距極座標(biāo)計(jì)算表自定義菜單“地形點(diǎn)坐標(biāo)”時(shí)，只需將過程名稱改一下：
Private Sub dxdzb ()
‘ 上述過程語(yǔ)句體不變
……
End Sub
4.1.6 Function 過程
Function 過程是一系列由 Function 和 End Function 語(yǔ)句所包含起來(lái)的 Visual Basic 語(yǔ)句。Function 過程和 Sub 過程很類似，但函數(shù)可以返回一個(gè)值。Function 過程可經(jīng)由調(diào)用過程通過傳遞參數(shù)，例如常數(shù)、變量、或是表達(dá)式等來(lái)調(diào)用它。如果一個(gè) Function 過程沒有參數(shù)，它的 Function 語(yǔ)句必須包含一個(gè)空的圓括號(hào)。函數(shù)會(huì)在過程的一個(gè)或多個(gè)語(yǔ)句中指定一個(gè)值給函數(shù)名稱來(lái)返回值。
在下面的示例中，Celsius 函數(shù)會(huì)根據(jù)華式溫度來(lái)計(jì)算攝氏溫度。當(dāng) Main 過程調(diào)用此函數(shù)時(shí)，會(huì)有一包含參數(shù)值的變量傳遞給此函數(shù)。而計(jì)算的結(jié)果會(huì)返回到調(diào)用的過程，并且顯示在一個(gè)消息框中。
Sub Main()
temp = Application.InputBox(Prompt:= _
"Please enter the temperature in degrees F.", Type:=1)
MsgBox "The temperature is " & Celsius(temp) & " degrees C."
End Sub
Function Celsius(fDegrees)
Celsius = (fDegrees - 32) * 5 / 9
End Function
4.1.7 寫 Visual Basic 語(yǔ)句
Visual Basic 中的語(yǔ)句是一個(gè)完整的命令。它可以包含關(guān)鍵字、運(yùn)算符、變量、常數(shù)，以及表達(dá)式。每一個(gè)語(yǔ)句都屬于下列三種分類之一：
聲明語(yǔ)句，它會(huì)為變量、常數(shù)、或程序取名稱，并且指定一個(gè)數(shù)據(jù)類型。
賦值語(yǔ)句，它會(huì)指定一個(gè)值或表達(dá)式給變量或常數(shù)。
可執(zhí)行語(yǔ)句，它會(huì)初始化動(dòng)作。它可以執(zhí)行一個(gè)方法或是函數(shù)，并且可以循環(huán)或從代碼塊中分支執(zhí)行?？蓤?zhí)行的語(yǔ)句通常包含數(shù)學(xué)的或條件的運(yùn)算符。
將語(yǔ)句連續(xù)地寫在數(shù)行上
通常是將一個(gè)語(yǔ)句寫在同一行中，但也可以利用一個(gè)續(xù)行符（空格_）將語(yǔ)句連續(xù)到下一行中。下面的示例中，可執(zhí)行語(yǔ)句 MsgBox 被接續(xù)的寫在三行中：
Sub DemoBox() '該過程聲明一個(gè)字符串變量，
'指定它值為 Claudia，然后顯示一個(gè)
'連接的消息。
Dim myVar As String
myVar = "朋友"
MsgBox Prompt:="您好" & myVar, _
Title:="問候框", _
Buttons:=vbExclamation
End Sub
添加注釋
注釋可以為讀代碼的人解釋過程或是特別的命令。Visual Basic 在運(yùn)行過程時(shí)，會(huì)忽略掉注釋。注釋行可由省略符號(hào)（'）或 Rem 接著一個(gè)空格做為開始，并且可以加在過程的任何地方。為了在語(yǔ)句的同一行中添加注釋，必須在語(yǔ)句后面插入一個(gè)省略符號(hào)，然后加上注釋文本。按照缺省規(guī)定，注釋會(huì)以綠色文本顯示。
檢查語(yǔ)法錯(cuò)誤
如果在鍵入一行代碼后按下 ENTER 鍵，此行代碼以紅色文本顯示（同時(shí)可能也顯示一個(gè)錯(cuò)誤信息），則必須找出語(yǔ)句中的錯(cuò)誤并更正它。
4.2 電子表格專業(yè)計(jì)算編程的一般步驟
了解了VB編程基本語(yǔ)法后，返回專業(yè)函數(shù)的編程是不是更明白了？學(xué)習(xí)和實(shí)踐的過程就是這樣，需要反反復(fù)復(fù)，才能弄明白。下面就要用前面掌握的知識(shí)，在Microsoft Excel電子表格這個(gè)優(yōu)秀平臺(tái)上進(jìn)行二次開發(fā)，徹底解決各類專業(yè)的復(fù)雜計(jì)算。
首先，需要了解一下電子表格編程計(jì)算的一般步驟。為了簡(jiǎn)明、清晰，還是用框圖來(lái)表示。
4.3 實(shí)戰(zhàn):一個(gè)表面積測(cè)算系統(tǒng)
下面還是來(lái)實(shí)戰(zhàn)一下，心才能踏實(shí)下來(lái)。選一個(gè)什么課題呢？
在高速公路兩側(cè)，對(duì)施工中破壞的地表植被要實(shí)施地表綠化工程，這在工程驗(yàn)收中就需要進(jìn)行表面積的測(cè)算。
表面積如何進(jìn)行測(cè)算？
如圖，測(cè)出地面點(diǎn)1，2，3，4，5，6，7，8，9的坐標(biāo)Xi、Yi和高程Hi，以空間三角形面積①～⑦來(lái)擬合地表面積。
因此，需要新編以空間三角形3頂點(diǎn)的坐標(biāo)Xi, Yi, Hi為參數(shù)，計(jì)算空間三角形面積函數(shù)Kjsjxp()；以及空間任意兩點(diǎn)間的距離函數(shù)Sk()；如果地面點(diǎn)是以視距極坐標(biāo)施測(cè)，還需編制以視距測(cè)量觀測(cè)值：視距Di，天頂距Zi，方位角fwj，儀高ig，覘高cg為參數(shù)的視距極坐標(biāo)計(jì)算函數(shù)sjx()， sjy()，sjh()以及角度以“度.分秒”為單位的三角函數(shù)Sind()，Cosd()，Tand()，“度.分秒”轉(zhuǎn)換成弧度的函數(shù)Rad()等。將這些系統(tǒng)沒有的函數(shù)編制成一個(gè)公共模塊：打開Excel，選擇“工具”→“宏”→“Visual Basic編輯器”→“插入”→“模塊”，在代碼編輯窗口中輸入如下函數(shù)代碼：
' 1. 常數(shù)
Public Const M_SEC# = 206264.8
Public Const M_DEG# = 57.2957795130823
Public Const M_RAD# = 1.74532925199433E-02
Public Const M_PI# = 3.14159265358979
' 2. “° ′ ″ ”角度轉(zhuǎn)換為弧度
Public Function Rad(ByVal angle As Double) As Double
Dim A As Double, B As Double, C As Double, D As Double
Dim ang As Double, sign As Integer
ang = Abs(angle) + 0.0000000000001: sign = Sgn(angle)
A = Int(ang): B = (ang - A) * 100#: C = Int(B): D = (B - C) * 100#
Rad = sign * (A + C / 60# + D / 3600#) * M_RAD
End Function
' 3. 正弦sind（度.分秒）
Public Function sind(ByVal x As Double) As Double
sind = Sin(Rad(x))
End Function
' 4. 余弦cosd（度.分秒）
Public Function cosd(ByVal x As Double) As Double
cosd = Cos(Rad(x))
End Function
' 5. 正切tand（度.分秒）
Public Function tand(ByVal x As Double) As Double
tand = Tan(Rad(x))
End Function
' 6. 余切ctnd（度.分秒）
Public Function ctnd(ByVal x As Double) As Double
ctnd = 1 / Tan(Rad(x) + 0.00000000000001)
End Function
' 7. 平面兩點(diǎn)間方位角
Public Function Fwj(ByVal xa As Double, ByVal ya As Double, ByVal xb As Double, ByVal yb As Double) As Double
Fwj = M_PI * (1 - Sgn(yb - ya) / 2) - Atn((xb - xa) / (yb - ya + 0.00000000000001))
End Function
' 8. 平面兩點(diǎn)間邊長(zhǎng)
Public Function Sp(ByVal xa As Double, ByVal ya As Double, ByVal xb As Double, ByVal yb As Double) As Double
Sp = Round(Sqr((xb - xa) ^ 2 + (yb - ya) ^ 2), 4)
End Function
' 9. 視距坐標(biāo)X
Public Function Sjx(ByVal di As Double, ByVal zi As Double, ByVal fwa As Double) As Double
Sjx = Round(di * sind(zi) ^ 2 * cosd(fwa), 2)
End Function
' 10. 視距坐標(biāo)Y
Public Function Sjy(ByVal di As Double, ByVal zi As Double, ByVal fwa As Double) As Double
Sjy = Round(di * sind(zi) ^ 2 * sind(fwa), 2)
End Function
' 11. 視距高差
Public Function Sjh(ByVal di As Double, ByVal zi As Double, ByVal ig As Double, ByVal cg As Double) As Double
Sjh = Round(di * sind(zi) * cosd(zi) + ig - cg, 2)
End Function
' 12. 空間兩點(diǎn)間距離
Public Function Sk(ByVal xx1 As Double, ByVal yy1 As Double, ByVal hh1 As Double, ByVal xx2 As Double, _
ByVal yy2 As Double, ByVal hh2 As Double) As Double
Sk = Round(Sqr((xx2 - xx1) ^ 2 + (yy2 - yy1) ^ 2 + (hh2 - hh1) ^ 2), 6)
End Function
'13 空間三角形面積
Public Function Kjsjxp(ByVal x1 As Double, ByVal y1 As Double, ByVal h1 As Double, ByVal x2 As Double, _
ByVal y2 As Double, ByVal h2 As Double, ByVal x3 As Double, ByVal y3 As Double, ByVal h3 As Double) As Double
Dim A As Double, B As Double, C As Double, D As Double, s As Double
Dim xx1 As Double, yy1 As Double, hh1 As Double, xx2 As Double, yy2 As Double, hh2 As Double
If x1 = 0 Or x2 = 0 Or x3 = 0 Then GoTo js
xx1 = x1: yy1 = y1: hh1 = h1: xx2 = x2: yy2 = y2: hh2 = h2
A = Sk(ByVal xx1, yy1, hh1, xx2, yy2, hh2)
xx1 = x2: yy1 = y2: hh1 = h2: xx2 = x3: yy2 = y3: hh2 = h3
B = Sk(ByVal xx1, yy1, hh1, xx2, yy2, hh2)
xx1 = x1: yy1 = y1: hh1 = h1: xx2 = x3: yy2 = y3: hh2 = h3
C = Sk(ByVal xx1, yy1, hh1, xx2, yy2, hh2)
D = (A + B + C) / 2
Kjsjxp = Round(Sqr(D * (D - A) * (D - B) * (D - C)), 3)
js:
End Function
' 14. 正三角截柱重心坐標(biāo)
Public Function Zsjjzx(ByVal x1 As Double, ByVal x2 As Double, ByVal x3 As Double) As Double
If x3 = 0 Or x2 = 0 Or x1 = 0 Then GoTo js
Zsjjzx = Int((x1 + x2 + x3) / 3)
js:
End Function
Public Function Zsjjzy(ByVal y1 As Double, ByVal y2 As Double, ByVal y3 As Double) As Double
If y3 = 0 Or y2 = 0 Or y1 = 0 Then GoTo js
Zsjjzy = Int((y1 + y2 + y3) / 3)
js:
End Function
進(jìn)行編譯，成功后退出。
此外，依據(jù)計(jì)算表的設(shè)計(jì)，需要調(diào)用的常用系統(tǒng)函數(shù)有：顯示日期“Today()”，計(jì)算非空單元格個(gè)數(shù)“COUNTA(單元格區(qū)域)”，求和“SUM(單元格區(qū)域)”，在數(shù)據(jù)區(qū)域中查找指定數(shù)據(jù)“VLOOKUP(RC[-1],dxdzb,6,False)”（在命名dxdzb的區(qū)域中查找與RC(-1)指定點(diǎn)號(hào)行完全匹配的相應(yīng)的第6列數(shù)據(jù)），等等。
接下來(lái)，依據(jù)專業(yè)計(jì)算項(xiàng)目精心設(shè)計(jì)計(jì)算表式樣。本實(shí)戰(zhàn)例：工作表1用來(lái)計(jì)算地形點(diǎn)坐標(biāo)；工作表2用來(lái)計(jì)算表面積。設(shè)計(jì)式樣如下：
  往下就是逐一對(duì)工作表進(jìn)行編程：1. 對(duì)有關(guān)計(jì)算單元格用代碼寫入公式；2. 手動(dòng)或用代碼設(shè)置工作簿界面；3. 手動(dòng)或用代碼設(shè)置工作表選項(xiàng)。
工作表1：
1， 選擇“視圖”→“工具欄”→“控件工具箱”→在J2單元格處拖出一個(gè)“命令按鈕”，打開“屬性窗口”設(shè)置：①名稱＝dxdzbButtonl；②Backcolor＝選你喜歡的背景色；③Caption＝啟動(dòng)計(jì)算；④Font＝宋體；⑤ForeColor＝選你喜歡的前景色；⑥PrintObject＝False；Shadow＝True。
2， 雙擊“啟動(dòng)計(jì)算”按鈕，進(jìn)入“VB代碼編輯窗口”，輸入如下代碼（‘ ***注釋語(yǔ)句，輸入代碼時(shí)可省略）：
' 地形點(diǎn)視距極座標(biāo)計(jì)算表“選擇按鈕”過程
‘聲明工作表1私有的過程dxdzbButton1_Click()…End Sub
Private Sub dxdzbButton1_Click()
Dim xzan As String ‘ 聲明變量xzan
Dim msg, style, title, response ‘ 聲明變量msg, style, title, response
Application.AskToUpdateLinks = False ‘ 取消Excel的更新鏈接
Sheet1.Visible = xlSheetVisible ‘ 設(shè)置Sheet1（“地形點(diǎn)”）可見
Sheet3.Visible = xlSheetVisible ‘ 設(shè)置Sheet3（“操作指南”）可見
Sheet2.Visible = xlSheetHidden ‘ 設(shè)置Sheet2（“表面積”）不可見
Sheet1.Activate ‘ 激活Sheet1
Range("J4").Select ‘ 選擇J4單元格
‘ 輸入公式"=COUNTA(R[1]C[-8]:R[396]C[-8])"，計(jì)算B5:B400有數(shù)字的單元格的數(shù)量
ActiveCell.FormulaR1C1 =
‘ 在K5單元格輸入公式，將點(diǎn)的坐標(biāo)數(shù)據(jù)轉(zhuǎn)換成cass的展點(diǎn)文件格式
Range("K5").Select
ActiveCell.FormulaR1C1 = "=IF(RC[-9]=0,0,RC[-9]&"",""&"",""&RC[-3]&"",""&RC[-4]&"",""&RC[-2])"
‘ 將K5單元格的公式自動(dòng)填充到K100
Range("K5").Select
Selection.AutoFill Destination:=Range("K5:K100"), Type:=xlFillDefault
‘ 在F2單元格輸入公式，自動(dòng)顯示系統(tǒng)日期
Range("F2").Select
ActiveCell.FormulaR1C1 = "=Today()"
‘ 設(shè)置隱藏工作表活動(dòng)窗口0值
ActiveWindow.DisplayZeros = False
‘ 卸載自編函數(shù)"新增測(cè)繪、工程、科學(xué)計(jì)算函數(shù)1.0"加載宏
AddIns("新增測(cè)繪、工程、科學(xué)計(jì)算函數(shù)1.0").Installed = False
‘ 卸載A5單元格
Range("A5").Select
ks: ‘ 表示開始的標(biāo)號(hào)，用于程序轉(zhuǎn)移的目標(biāo)
‘ 賦值語(yǔ)句，將InputBox()函數(shù)的返回值賦予變量xzan，InputBox()函數(shù)會(huì)出現(xiàn)一個(gè)標(biāo)題為”請(qǐng)選擇項(xiàng)目”（不含“”）的輸入框，依據(jù)選擇項(xiàng)目輸入相應(yīng)的數(shù)字
xzan = InputBox("0,→清空；1,→算表面積；2.寫入公式－10； 3,計(jì)算－100", ”請(qǐng)選擇項(xiàng)目”)
‘ 條件語(yǔ)句，當(dāng)xzan = ""，程序轉(zhuǎn)移到標(biāo)號(hào)js，否則執(zhí)行下面語(yǔ)句
If xzan = "" Then GoTo js
‘ Select Case xzan ……End Select語(yǔ)句，依據(jù)xzan選擇Case "i"
Select Case xzan
‘ 當(dāng)在輸入框輸入0時(shí)，程序執(zhí)行Case "0"下的語(yǔ)句體
Case "0"
msg = "確實(shí)要清空嗎？" ‘ 賦值語(yǔ)句
style = vbYesNo + vbInformation + vbDefaultButton2 ‘ 賦值語(yǔ)句
title = "提示" ‘ 賦值語(yǔ)句
= MsgBox(msg, style, title) ‘ 賦值語(yǔ)句，response＝ MsgBox(msg, style, title)函數(shù)（提示框）返回值
‘ 條件語(yǔ)句，response = vbYes（在提示框單擊“是”）執(zhí)行Then后的語(yǔ)句體：清除A5:I400區(qū)域內(nèi)容
If response = vbYes Then
Range("A5:I400").Select
Selection.ClearContents
Range("A5").Select
‘ 條件語(yǔ)句，否則response = vbNo，則結(jié)束條件語(yǔ)句
ElseIf response = vbNo Then
End If
‘ 當(dāng)在輸入框輸入1時(shí)，程序執(zhí)行Case "1"下的語(yǔ)句體
Case "1"
msg = "確定進(jìn)入表面積計(jì)算嗎？"
style = vbYesNo + vbInformation + vbDefaultButton2
title = "提示"
response = MsgBox(msg, style, title)
If response = vbYes Then
Sheet2.Visible = xlSheetVisible
Sheet3.Visible = xlSheetVisible
Sheet1.Visible = xlSheetHidden
Sheet2.Activate
ElseIf response = vbNo Then GoTo ks
End If
‘ 當(dāng)在輸入框輸入2時(shí)，程序執(zhí)行Case "2"下的語(yǔ)句體：在G6,H6,I6單元格輸入公式
Case "2"
Range("G6").Select
ActiveCell.FormulaR1C1 = "=IF(RC[-4]=0,0,sjx(RC[-4],RC[-2],RC[-1])+R5C7)"
Range("H6").Select
ActiveCell.FormulaR1C1 = "=IF(RC[-5]=0,0,sjy(RC[-5],RC[-3],RC[-2])+R5C8)"
Range("I6").Select
ActiveCell.FormulaR1C1 = "=IF(RC[-6]=0,0,sjh(RC[-6],RC[-4],R6C1,RC[-5])+R5C9)"
‘ 對(duì)G6,H6,I6單元格公式自動(dòng)填充到第10行
Range("G6:I6").Select
Selection.AutoFill Destination:=Range("G6:I10"), Type:=xlFillDefault
‘ 顯示消息框：提示下面的操作，并依據(jù)響應(yīng)的操作退出
msg = "請(qǐng)?jiān)诰庉嫏谛薷腎6單元格公式：將公式中的絕對(duì)引用改為相應(yīng)數(shù)據(jù)（儀高、起算高程）；并對(duì)G6,H6的公式中的絕對(duì)引用作同樣的修改；然后選擇項(xiàng)目“3”…* 注意：每一新測(cè)站都應(yīng)該對(duì)起算數(shù)據(jù)進(jìn)行相應(yīng)的修改，然后按常規(guī)用鼠標(biāo)進(jìn)行拖拉填充！"
style = vbYesNo + vbInformation + vbDefaultButton2
title = "提示"
response = MsgBox(msg, style, title)
If response = vbYes Or response = vbNo Then
GoTo js
End If
‘ 當(dāng)在輸入框輸入3時(shí)，程序執(zhí)行Case "3"下的語(yǔ)句體：自動(dòng)填充"G6:I100"
Case "3"
Range("G6:I6").Select
Selection.AutoFill Destination:=Range("G6:I100"), Type:=xlFillDefault
Range("G50").Select
GoTo js
End Select
js:
End Sub
工作表2：
操作與工作表1中1，2，相似，代碼如下：
' 表面積計(jì)算“選擇按鈕”過程宏
Private Sub bmjjsButton1_Click()
Dim xzan As String
Dim msg, style, title, response
Application.AskToUpdateLinks = False
Sheet2.Visible = xlSheetVisible
Sheet3.Visible = xlSheetVisible
Sheet1.Visible = xlSheetVisible
Sheet1.Activate
ActiveWorkbook.Names.Add Name:="dxdzb", RefersToR1C1:="=地形點(diǎn)!R5C2:R400C9"
Sheet1.Visible = xlSheetHidden
Sheet2.Activate
Range("E6").Select
ActiveCell.FormulaR1C1 = "=COUNTA(R[1]C:R[394]C)"
Range("E3").Select
ActiveCell.FormulaR1C1 = "=SUM(R[4]C[3]:R[397]C[3])"
Range("I6").Select
ActiveCell.FormulaR1C1 = "=COUNTA(R[1]C[-8]:R[394]C[-8])"
Range("J7").Select
ActiveCell.FormulaR1C1= _
"=IF(RC[-5]=0,0,RC[-5]&"",""&"",""&RC[-3]&"",""&RC[-4]&"",""&RC[-2])"
Range("J7").Select
Selection.AutoFill Destination:=Range("J7:J100"), Type:=xlFillDefault
Range("E2").Select
ActiveCell.FormulaR1C1 = "=Today()"
ActiveWindow.DisplayZeros = False ' 隱藏窗口0值★
Range("A7").Select
ks:
xzan = InputBox("0,清空；1,→地形點(diǎn)計(jì)算；2.寫入公式－100 ",”請(qǐng)選擇項(xiàng)目”)
If xzan = "" Then GoTo js
Select Case xzan
Case "0"
msg = "確實(shí)要清空嗎？"
style = vbYesNo + vbInformation + vbDefaultButton2
title = "提示"
response = MsgBox(msg, style, title)
If response = vbYes Then
Range("B7:J400").Select
Selection.ClearContents
Range("A7").Select
ElseIf response = vbNo Then
End If
Case "1"
msg = "確定進(jìn)入地形點(diǎn)計(jì)算嗎？"
style = vbYesNo + vbInformation + vbDefaultButton2
title = "提示"
response = MsgBox(msg, style, title)
If response = vbYes Then
Sheet1.Visible = xlSheetVisible
Sheet3.Visible = xlSheetVisible
Sheet2.Visible = xlSheetHidden
Sheet1.Activate
ElseIf response = vbNo Then GoTo ks
End If
Case "2"
Sheet2.Activate
Range("B7").Select
ActiveCell.FormulaR1C1 = "=IF(RC[-1]=0,0,VLOOKUP(RC[-1],dxdzb,6,False))"
Range("C7").Select
ActiveCell.FormulaR1C1 = "=IF(RC[-2]=0,0,VLOOKUP(RC[-2],dxdzb,7,False))"
Range("D7").Select
ActiveCell.FormulaR1C1 = "=IF(RC[-3]=0,0,VLOOKUP(RC[-3],dxdzb,8,False))"
Range("F7").Select
ActiveCell.FormulaR1C1 = "=IF(RC[-4]=0,0,zsjjzx(RC[-4],R[1]C[-4],R[2]C[-4]))"
Range("G7").Select
ActiveCell.FormulaR1C1 = "=IF(RC[-4]=0,0,zsjjzy(RC[-4],R[1]C[-4],R[2]C[-4]))"
Range("H7").Select
ActiveCell.FormulaR1C1 = _
"=IF(R[2]C[-6]=0,0,kjsjxp(RC[-6],RC[-5],RC[-4],R[1]C[-6],R[1]C[-5],R[1]C[-4],R[2]C[-6],R[2]C[-5],R[2]C[-4]))"
Range("B7:D7").Select
Selection.AutoFill Destination:=Range("B7:D100"), Type:=xlFillDefault
Range("F7:H7").Select
Selection.AutoFill Destination:=Range("F7:H100"), Type:=xlFillDefault
Range("E100").Select
‘ 顯示消息框：提示下面的操作，并依據(jù)響應(yīng)的操作退出
msg = "公式僅自動(dòng)填充至100行，超過100行，按常規(guī)用鼠標(biāo)從100開始進(jìn)行拖拉填充！"
style = vbYesNo + vbInformation + vbDefaultButton2
title = "提示"
response = MsgBox(msg, style, title)
If response = vbYes Or response = vbNo Then
GoTo js
End If
End Select
js:
End Sub
工作表3（操作指南）：
在工作表3插入一個(gè)文本框，寫進(jìn)有關(guān)計(jì)算操作的說明。
 過程代碼輸入完成后，進(jìn)行編譯，然后對(duì)程序進(jìn)行保護(hù)：在“ＶＢ編輯器”窗口，單擊“工具”→“VBAProject屬性…”→“保護(hù)”，選定“查看時(shí)鎖定工程”，輸入兩個(gè)相同密碼，“確定”，退出“ＶＢ編輯器”。
接下來(lái)，如果你還想對(duì)工作表的外觀界面進(jìn)一步設(shè)置，如：隱藏“工具欄”，“狀態(tài)欄”…以及其它設(shè)置，你可以按常規(guī)操作（勾銷“工具欄”的所有選項(xiàng)及菜單欄“工具”→“選項(xiàng)”下的顯示項(xiàng)目）進(jìn)行設(shè)置，當(dāng)然也可根據(jù)需要用代碼進(jìn)行設(shè)置，這都不是重要的。
最后“保存”，OK！一個(gè)實(shí)用的表面積計(jì)算系統(tǒng)編制完成。
仿照上述操作過程，你已經(jīng)可以對(duì)專業(yè)計(jì)算項(xiàng)目進(jìn)行編程自動(dòng)化計(jì)算了。
寫在后面前面所寫的，只是我對(duì)電子表格VBA編程，解決專業(yè)復(fù)雜計(jì)算探索中的一點(diǎn)心得。對(duì)電子表格VBA編程來(lái)說，這僅僅是個(gè)“開始”。事情就是這樣，越是深入進(jìn)去，越是感到知識(shí)的浩瀚和自己的無(wú)知。我在探索中的最重要的心得就是：編程并不難，代碼是規(guī)定的，解決問題的思路才是最最關(guān)鍵的。根據(jù)思路去“幫助”中找代碼，在學(xué)代碼中調(diào)整思路，邊學(xué)、邊積累、邊提高，這是學(xué)習(xí)VBA編程的最好途徑。希望專家、高手們寫一些“菜鳥”看得懂，用的上，推的開的書來(lái)提高一下，這將是對(duì)非編程專業(yè)的廣大科技界、工程界……的朋友們的一大貢獻(xiàn)。我的這點(diǎn)心得，權(quán)當(dāng)拋磚引玉……。 |
|
|
