高級程度 - ExcelHelp.net - 探討Excel的威力

排序及篩選 [2001年3月]

張貼者：2010年5月29日清晨6:37Administrator ExcelHelp [ 已更新 2010年5月29日清晨6:38 ]

介紹
根據用戶指定的條件，把資料庫內的資料排序及篩選，資料有多少欄也可以。十分實用吧？！

　　用法很簡單，只要在執行巨集以後，選出檢索欄，巨集會馬上顯示檢索欄中所有獨一無二的值，然後再選要篩選出來的記錄，選項可以多於一個：

程式碼
程式碼較複雜和長，不在此刊登，請下載附檔。

使用的指令／方法
- 對話框裡的ComboBox、ListBox、CommandButtons和AddItem。
- Sort及AdvancedFilter
- Set

使用的函數／屬性
- CurrentRegion

注意地方
- 資料庫的四周必須為空行或空欄，否則屬性CurrentRegion會算錯。
- 用For Each...Next的時候，如果用作迴圈的範圍的橫向一字形的，你需要多加.Columns在後面，否則迴圈只會跑一次，如：
　　For Each rI In rTemp.Columns
　　 cbKeyField.AddItem rI.value
　　Next
- 在「選出」欄裡不管全選也好，完全沒選也好，會當作光排序論。

已知問題／蟲
- 沒有

| 附件: 3_9.zip

核對香港身份證 [2002年2月]

張貼者：2010年5月29日清晨6:36Administrator ExcelHelp [ Carson Cheng 已於 2011年1月19日晚上11:57 更新 ]

在這個數碼年代，我們日常生活中都要面對許許多多的數字，身份證號碼是其一。
　　香港身份證號碼後端，有一雙括號，括號內有一個數字（或「Ａ」字），叫「校檢碼（Check Digit）」，許多人都只知其名，而不知其義，這次就讓我介紹一下。
　　在輸入資料時，如果由人手輸入，錯誤的機會當然大，就算利用條碼 (Barcode) 也難保輸入無誤，所以校檢碼就應運而生。透過一條公式，我們把一組數字轉化成一個校檢碼，如果這組數字內有任何一個數字改變了，公式就會產生一個不一樣的校檢碼（如果這條公式會產生一個跟原來一樣的校檢碼，這條公式就不可以接受）。
　　當你輸入了一個身份證號碼（包括校檢碼），電腦可以馬上運用公式把括號前端的字母和數字算出一個校檢碼，如果這個校檢碼跟括號內的校檢碼一樣，那就代表正確的機會很大；相反，如果不一致的話，就可以肯定輸入的號碼是錯誤的。
　　校檢碼的公式不很複雜，用一個例子說明就很容易理解：

　　而當前方有一個Ｘ時，則在累積數加上6：

註：

第二個英文字母的代表數字：Ａ為１，Ｂ為２，Ｃ為３，如此類推。
英文字母可以是兩個位，絕大部分人的身份證都只有一個位。
校檢碼如果是10，用「A」代表；是11的話，用「0」代表。

示範

程式碼如下：
' HKID 決定輸入裡的香港身份證編號是否正確
' 輸入：sInput: "AA999999(9)" 或 "A999999(9)"
' 輸出：香港身份證編號是否正確
Function HKID(sInput As String) As Boolean
Dim iAcc As Integer ' 累加變數
Dim sCheck As String
Dim i As Integer

' 如果sInput只有10位（包括括號），則在前面多加一個空位
If Len(sInput) = 10 Then sInput = " " & sInput

' 如果sInput的文字長度是11，且第一個字母不是Ｘ就是空格，且文字中第9和11位的是括號，
' 則繼續運算，否則已經可確定sInput是錯誤的。
If Len(sInput) = 11 And (Left(sInput, 1) = " " Or Left(sInput, 1) = "X") And _
Mid(sInput, 9, 1) = "(" And Right(sInput, 1) = ")" Then

' 起始化
sInput = UCase(sInput) ' 把英文都轉成大草
sCheck = Mid(sInput, 10, 1) ' 校檢碼
iAcc = 0 　 ' 累加變數

' 英文部分（第1、2位）
' 第一個字母：如果是X的話，則加上6
If Left(sInput, 1) = "X" Then iAcc = iAcc + 6
' 第二個字母：A 代表 1; B 代表 2 如此類推，然後乘上8
iAcc = iAcc + (Asc(Mid(sInput, 2, 1)) - 64) * 8

' 數字部分（第3到8位）
' 第一個數字（由左至右）乘上7，第二個數字乘上6，如此類推
For i = 3 To 8
iAcc = iAcc + Val(Mid(sInput, i, 1)) * (10 - i)
Next i

' 校檢碼等於11減去累積數除以11的餘數，會得出一個1至11的數字
iAcc = 11 - iAcc Mod 11

' 看看這裡算出的校檢碼與輸入的是否一致
' 如果算出的校檢碼是10的話，則用"A"代表；是11的話，則用0代表。
Select Case iAcc
Case 10
HKID = (sCheck = "A")
Case 11
HKID = (sCheck = "0")
Case Else
HKID = (sCheck = Trim(Str(iAcc Mod 10)))
End Select
Else
HKID = False
End If
End Function

我現在還沒有弄清楚第一個英文字母的計算方法，主要是不知道是否只可以是「X」，如有錯誤，請不吝指正！在此特別謝謝Frankie Wong！

| 附件: 3_5.zip

簡單計算機 [2002年6月]

張貼者：2010年5月29日清晨6:35Administrator ExcelHelp [ 已更新 2010年5月29日清晨6:35 ]

簡介
有會員問，如何在Excel上制作一部簡單、最基本的計算機，雖然實用性很低，但用來學ＶＢＡ則是個非常好的題材。

使用的功能
表格中的按鈕 (Buttons)
On Error Goto XXX

使用的函數／屬性
Application.Caller

技巧

由於我們的開發平台是Excel，故此可以利用Excel本身的運算功能。我們不用自行運算（所以不用愁先乘除後加減），只要把用戶輸入的按鍵一個一個地用文字方法先存下（下面叫顯示字串），到了用戶按 = 按鈕便把文字轉為公式，答案自然會跑出來。
但凡有任何錯誤，例如除零、公式錯誤等，都利用On Error Goto顯示「Error」。
所有按鈕都統一執行ProcessKey。命名按鈕時，直接用加減乘除的符號，方便處理，但由於名稱不能以符號為首，故在所有按鈕名稱前統一加上"Button"，處理按鍵時把"Button"刪掉即可。

程式

' 處理按鍵
Sub ProcessKey()
Dim sButton As String
Dim rDisplay As Range

' 起始
On Error GoTo ShowError ' 遇有任何錯誤則顯示「ERROR」
Set rDisplay = Range("Display") ' 顯示屏，也是顯示字串和公式的所在地
sButton = Mid(Application.Caller, 7, 99) ' 看看用戶按了哪個按鈕
' 例如＋鍵，Caller返回"Button+"，sButton將是"+"

Select Case sButton
Case "AC"
' 把顯示字串刪除
rDisplay.Numberformat = "@" ' 把數字格式轉到文字
rDisplay.value = ""
Case "CE"
' 把顯示字串右邊的數字（如有）刪除
Do While IsNumber(Right(rDisplay.value, 1))
rDisplay.value = Left(rDisplay.value, Len(rDisplay.value) - 1)
Loop
Case "="
' 把顯示字串轉為公式
If rDisplay.value <> "" Then
rDisplay.Numberformat = "General" ' 把數字格式轉回通用
rDisplay.formula = "=" & rDisplay.value
End If
Case Else
' 所有其他按鈕只需加到顯示字串後便可
rDisplay.value = rDisplay.value & sButton
End Select
Exit Sub

' 有錯誤的話，顯示「ERROR」
ShowError:
rDisplay.value = "ERROR"
End Sub

' 測試來源字串（的第一個字符）是否一個數字
Private Function IsNumber(sInput As String) As Boolean
IsNumber = (sInput >= "0" And sInput <= "9") Or sInput = "."
End Function

注意：我沒有使用有千位分隔號的數字格式，這部分留給你自行研究。

| 附件: 3_2.zip

過三關（Tic Tac Toe）[2002年1月]

張貼者：2010年5月29日清晨6:33Administrator ExcelHelp [ 已更新 2010年5月29日清晨6:34 ]

這個遊戲大家還沒有上學該已學會了，但是要放在Excel裡卻不是件簡單的事情，必須掌握自訂表單（Userform）的技巧。

由於我主要想示範一下表單與Static的用法，所以沒有加進什麼 AI（人功智能），電腦不懂跟你玩，只能人與人玩，電腦提供「場地」和當評判。

首先畫一個表單，上有九個按鈕，代表九個格，用戶按一下，我們就在其上「畫」上「○」或「╳」。另外還要一個「離開」按鈕，讓用戶可以提早結束遊戲。

每走一步，Excel也會在適當的方格上「畫」上○或╳，並顯示到哪一方下棋。
　　玩家可以隨時按「離開」結束遊戲。

當有一方勝出後，Excel會顯示哪一方勝出，並會把沒有選過的按鈕改為失效，不讓玩家們繼續。

如果選完九個格也沒有定勝負的話，Excel會顯示「和局」。

| 附件: 3_11.zip

猶如親手打字 [1999年3月]

張貼者：2010年5月29日清晨6:32Administrator ExcelHelp [ 已更新 2010年5月29日清晨6:32 ]

核對信用卡號碼 [2001年10月]

張貼者：2010年5月29日清晨6:31Administrator ExcelHelp [ 已更新 2010年5月29日清晨6:32 ]

這裡介紹兩個關於信用卡號碼的函數，兩個函數一併使用，就可以決定一個信用卡號碼是否正確。當然，這個範例對初學巨集的人也是一個很好的練習。

Luhn算式
首先介紹一個叫Luhn的算式，它可以決定一系列的數字是否正確。
　　算法很蠻簡單，從右到左，把單數數位（如個位、百位等）的數值則可以直接累計起來；雙數數數位（如十位、千位）的數值則乘２，如大於９則減９，然後把得出的數字累計起來；。最後累計得來的數值如果是１０的倍數，信用卡號碼則為正確。
　　用6528做個例子：

　　由於累計數20是10的倍數，也就是說可以給10除盡，故此6528這個數字是符合Luhn算式的。

語法：

' 信用卡號碼是否正確
Function IsValidCreditCardNo(sCreditCard As String) As Boolean
   Dim iCardNoLen As Integer  ' 信用卡號碼長度
   Dim iSum As Integer             ' 累計用
   Dim i As Integer
   Dim iTemp As Integer
   
   ' 起始化
   iCardNoLen = Len(sCreditCard) ' 信用卡號碼長度
   iSum = 0                                      ' 用作累計的變數
   
   ' 單數（由右至左）的數位直接加到累計
   For i = iCardNoLen To 1 Step -2
       iSum = iSum + Mid(sCreditCard, i, 1)
   Next i
   
   ' 雙數（由右至左）的數位乘２後，如大於９則減９，然後加到累計
   For i = iCardNoLen - 1 To 1 Step -2
       iTemp = Mid(sCreditCard, i, 1) * 2
       iSum = iSum + iTemp - IIf(iTemp > 9, 9, 0)
   Next i
   
   ' 如果累計數是１０的倍數，則輸入的卡號則為正確
   IsValidCreditCardNo = (iSum Mod 10 = 0)    
End Function

　　當然，我們知道這四個數字不可能是個信用卡號碼，故此我們需要另外一個函數。

信用卡的種類
下表列出較流行信用卡的種類，以及開首號碼與號碼長度。

　　這個函數要寫得簡單，必須知道 Like 的用法，以下是偵測JCB的寫法：

' JCB
If (sCreditCard Like "3*" And iCardNoLen = 16) Or _
((sCreditCard Like "2131*" Or sCreditCard Like "1800*") And _
iCardNoLen = 15) Then
CreditCardType = "JCB"
End If

注意地方：

在計算Luhn函數時，人一般會一個數字一個數字順序計算，但寫程序時，首先整批處理單位數字，然後才整批處理雙位數字，這樣會較簡潔。
在Luhn函數裡，不要這樣寫：
If iSum Mod 10 = 0 Then
IsValidCreditCardNo = True
Else
IsValidCreditCardNo = False
End If

這樣寫又簡單，又清楚：
IsValidCreditCardNo = (iSum Mod 10 = 0)
編寫帶有「和 AND」和「或 OR」的條件時，請看清楚括號是否正確，記著：AND的處理優先權比OR高。
不要以為輸入一個正確的信用卡號碼就可以在網上騙財！第一，受款公司可能直接連到信用卡公司，不存在的號碼原形畢露；第二，受款公司一定會記錄你付款的時間與當時候你的ＩＰ地址，要追查並不困難。

| 附件: 3_4.zip

模擬Access的輸入遮罩 [2003年3月]

張貼者：2010年5月29日清晨6:30Administrator ExcelHelp [ 已更新 2010年5月29日清晨6:30 ]

Excel 的TextBox不如Access的那樣，可以設定輸入遮罩(Input Mask)，以控制用戶輸入的文字。這個技巧就可以模擬輸入遮罩。

在這個例子當中，輸入文字的格式為"EXCEL999A"，也就是說，前方要有EXCEL字樣，其後的三個字符需為數字，最後有一個字母。

要注意的是，除了TextBox，我們還要一個Label，用作存放上一次輸入的正確文字，且要把它的Visible值設為False。

程式如下：

' 起始時，把預設的字串（這裡就是"EXCEL"）放進TextBox1和Label1。
Private Sub Userform_Initialize()
TextBox1.Text = "EXCEL"
Label1.Caption = TextBox1.Text
End Sub

' 當用戶更改文字方塊時，就要確定新輸入的文字符合規格。
Private Sub TextBox1_Change()
' 把輸入的文字轉到大寫（可有可無）
TextBox1.Text = UCase(TextBox1.Text)

' 如果輸入的文字正確的話，則把它記錄在隱藏的label裡；
' 否則，把記錄在label的值（也就是上一次輸入正確的文字）放回到輸入欄
If ValidString(TextBox1.Text) Then
Label1.Caption = TextBox1.Text
Else
TextBox1.Text = Label1.Caption
End If
End Sub

' 判別文字S是否正確
' 這裡的程式碼要按你的需要而修改。
' 這裡的技巧是，就算文字不夠長，也可以使用MID()，不會出現錯誤，這可以把程式碼寫得很簡單。
' 例如來源文字只有"ABC"，MID("ABC",5,1)不會發生錯誤，只會返回空字串 ""。
Private Function ValidString(S As String)
ValidString = False

If Len(S) >= 5 And Len(S) <= 9 Then
If Left(S, 5) = "EXCEL" Then
ValidString = IsDigit(Mid(S, 6, 1)) And IsDigit(Mid(S, 7, 1)) And _
IsDigit(Mid(S, 8, 1)) And IsLetter(Mid(S, 9, 1))
End If
End If
End Function

' 判別S字串是否一個數字，空字串也可以
Private Function IsDigit(S As String)
IsDigit = (S >= "0" And S <= "9") Or S = ""
End Function

' 判別S字串是否一個字母，空字串也可以
Private Function IsLetter(S As String)
IsLetter = (S >= "a" And S <= "z") Or (S >= "A" And S <= "Z") Or S = ""
End Function

執行的時候就像用了輸入遮罩：

| 附件: 3_12.zip

把所有已開啟的工作簿裡的所有工作表印出來

張貼者：2010年5月29日清晨6:28Administrator ExcelHelp [ 已更新 2010年5月29日清晨6:29 ]

因工作關係，要把許多檔案裡的每一張工作頁印出來，要人手逐一逐一按到每一張工作表，然後再按列印，費時失事！就算可以先選所有的工作表才列印，但還是蠻麻煩的。

這個小工具很簡單，用了兩個For...Next迴圈，做出「所有」的「所有」的效果。是個不錯的迴圈練習。

由於Workbooks和Worksheets都是物件，所以用 For Each 會比較簡單。

' 列印所有已開啟的工作簿裡的所有工作表
Sub PrintWorkbooks()
Dim WB As Object, WS As Object

' Workbooks物件載著所有已打開的工作簿
For Each WB In Workbooks
' Worksheets則載著工作簿WS裡所有工作頁
For Each WS In WB.Worksheets
' 只印出沒有隱藏的工作表，並且不要把自己印出來
' 我用工作表名稱來識別是否本檔自己
If WS.Name <> "ExcelHelp.net" And WS.Visible Then
WS.PrintOut
End If
Next
Next
End Sub

' 除了本檔，把所有已開啟的檔案關閉
Sub CloseWorkbooks()
Dim WB As Object

For Each WB In Workbooks
If WB.Sheets(1).Name <> "ExcelHelp.net" Then
WB.Close
End If
Next
End Sub

| 附件: 3_16.zip

存放文字儲存格的放大鏡 [2004年12月]

張貼者：2010年5月29日清晨6:27Administrator ExcelHelp [ 已更新 2010年5月29日清晨6:28 ]

也許你不知道，一個儲存格（單元格／Cell）可以存放32,767個字符，也就是兩三頁紙的長度！不過由1,024個字符開始，Excel便不會換行，以致後段的文字會一直排到超越儲存格的右邊界。

所以如果要輸入大量的文字進一個儲存格的話，就只能在公式欄那裡編輯。但由於公式欄字體大小不受控制，且欄寬太小，編輯工作有一定困難。於是我便寫了這個小工具，把儲存格的文字搬到一個Userform的TextBox裡編輯，編輯後拷回儲存格。不單可以自選字體及字體大小，還可以讓用戶用<Enter>來換行。

在設定Userform時，以下是一些較特別的設定：
－TextBox (存放文字的文字框) 的字體和字體大小，與兩個ComboBox兩邊的預設值要一致
－ComboBox的style要設為2 - fmstyleDropDownList，否則用戶便可以輸入不正確的值，導致執行錯誤
－TextBox 的 ScrollBars 設為 2 - fmScrollBarsVertical，那樣便可以有垂直的滾軸
－EnterKeyBehavior 設為 True，那用戶就不用按<Alt>+<Enter>來換行，可以直接用<Enter>

安裝方法：
１）開啟附檔後，選「檔案｜另存檔案」
２）儲存格式選「Add-in 增益集」，這個選項在末端
３）關掉附檔
４）隨便打開一個檔案，選「工具｜增益集」，確定已勾選 Magglass
５）現在在任何一個儲存格上，按<Ctrl>+q ，文字放大鏡便會跑出來！

取消安裝方法：
１）選「工具｜增益集」
２）勾除 MagGlass，選確定

| 附件: 3_17.zip

	搜尋這個協作平台