巨集的錄製與執行巨集的錄製與執行

VBA 與 VB 編輯器VBA 與 VB 編輯器

應用巨集程式範例應用巨集程式範例 4

2

3

1

Excel 簡易實用巨集設計Excel 簡易實用巨集設計

台大計資中心 教學組 林淑芬台大計資中心 教學組 林淑芬

流程控制基本指令

一 . 何謂巨集（ Macro ）？巨集 (Macro) 是將許多命令或操作過程記錄下來，彙總成單一按鈕動作或巨集指令以後只要呼叫此巨集，即可完成所有設定的命令或操作巨集適合應用於重複性很高的操作，將重複性的操作錄製成巨集，可簡化操作過程巨集是存放在 Visual Basic 模組中的一連串指令和函數

錄製新巨集

定義巨集名稱及快速鍵

相對參照與絕對參照

錄製完畢

執行巨集的方式

從巨集視窗中執行利用巨集的快速鍵執行製作巨集按鈕設計文字藝術師按鈕在工具列上設定巨集按鈕

從巨集視窗中執行

利用巨集的快速鍵執行

檢視表單工具列 - 選擇按鈕指令

為文字藝術師按鈕指定巨集

在工具列上設定巨集按鈕

將自訂按鈕拖移至工具列上

二 . 何謂 VBA ？

VBA （ Visual Basic for Application ）係專門應用於 Office 中的程式語法，其主要架構及語法都與 Visual Basic 相似VB 所發展的程式可一單獨在作業系統中執行， 而 VBA 則是為 Excel 、 Access 等 Office 成員所量身訂做的語言工具

VB 編輯器

錄製巨集所產生的 VBA 程式

新增 VBA 程式模組

VBA 可用的資料型態整數 Integer － 2Bytes長整數 Long － 4Bytes單精準浮點數 Single － 4Bytes倍精準浮點數 Double － 8Bytes金額數值型態 Currency － 8Bytes字串 String位元組 Byte － 1Bytes日期 Date邏輯 Boolean任何型別 Variant － 16Bytes

三 . 程式流程控制基本指令選擇結構– If… Then…End If– If… Then…Else…End If– Select Case…End Select

迴圈結構– For…Next– For Each…In…Next– Do…Loop

強迫跳離陳述式 Exit for Exit do

If… Then…End If

If 條件式 Then

….{ 條件式為 True}

End If

If… Then…Else…End If

If 條件式 Then

….{ 條件式為 True}

Else

….{ 條件式為 False}

End If

For…Next 迴圈

For 計次變數 = 起始值 To 終止值 (Step 間隔值 )

……

Next 計次變數

Do…Loop 陳述式

Do While|Until 條件式….

Loop

或Do

….

Loop While|Until 條件式

NO Score 　 　

1 　

2 * 　 　

3 *

4 * 　 　

5 　

6 　 　 　

7 　

8 　 　 　

9 *

10 　 　 　

Sub redline() Dim I As Integer I = 1 Worksheets(1).Select AA = Range("A" & I).ValueDo While AA <> "" If I Mod 2 <> 0 Then Rows(I).Interior.ColorIndex = 3 End If I = I + 1 AA = Range("A" & I).ValueLoopEnd Sub

Sub delstar() Dim I As Integer I = 1 Worksheets(1).Select AA = Range("A" & I).ValueDo While AA <> "" If Range("B" & I).Value = "*" Then Rows(I).Delete Else I = I + 1 End If AA = Range("A" & I).ValueLoopEnd Sub

ID Name Address TEL

A123456789 Alex 　 　

A123456789 Alex 　 　

A123456790 Test 　 　

A123456791 Test 　 　

A123456791 Test 　 　

A123456793 Good 　 　

A123456794 Good 　 　

A123456794 Tom 　 　

A123456795 Tom 　 　

A123456796 Tom 　 　

A123456797 Tom 　 　

兩個 key 都相同才刪 需先排序兩個 keySub delsame() Dim I As Integer I = 2 Worksheets(2).Select AA = Range("A" & I).Value BB = Range("B" & I).Value I = I + 1Do While AA <> "" If Range("A" & I).Value = AA And Range("B" & I).Value = BB Then Rows(I).Delete Else AA = Range("A" & I).Value BB = Range("B" & I).Value I = I + 1 End IfLoopEnd Sub

計算 key 不重複的有幾筆 需先排序Sub countunique() Dim I, count As Integer I = 2 count = 0 Worksheets(1).Select AA = Range("A" & I).Value I = I + 1Do While AA <> "" If Range("A" & I).Value <> AA Then count = count + 1 AA = Range("A" & I).Value End If I = I + 1LoopRange("M1").Value = countEnd Sub

多頁的明細資料匯總成一頁總表Sub ALL() Dim i, j As IntegerDim sh As Stringi = 5 'Row beginning in TOTAL sheetFor N = 1 To 5 'You must enter how many Sheet? sh = "sheet" & N Worksheets(sh).Select Value1 = Range("G2").Value Value2 = Range("D2").Value Value3 = Range("L2").Value Worksheets("TOTAL").Select ' TOTAL sheet Range("A" & i).Value = N Range("B" & i).Value = Value1 Range("C" & i).Value = Value2 Range("D" & i).Value = Value3 i = i + 1NextEnd Sub

以 Cells(i, j) 將 sheet 表示為二維矩陣

矩陣相乘的程式碼Sub Array_Mult()Dim i, j, k, temp As IntegerWorksheets(1).Select For k = 1 To 3 For i = 1 To 3 temp= 0 For j = 1 To 2 temp = temp + (Cells(i + 2, j + 1) * Cells(j + 2, 4 + k)) Next j Cells(6 + i, k + 1) = temp Next iNext kEnd Sub

ChartNo ItemName Value1

0688522 ALB 4.7

0688522 Alpha-Fetoprotein 3.60

0688522 ALT 34

0688522 Anti-HBs Non-reactive(0.0)

0688522Anti-Hepatitis C

VirusNon-reactive(0.05)

0688522 AST 28

0688522 Aty.Lym. 0688522 Bacteria -

0731146 ALT 14

0731146 Anti-HBs Non-reactive(0.0)

0731146Anti-Hepatitis C

VirusNon-reactive(0.06)

0731146 AST 13

0731146 Aty.Lym. 0731146 Bacteria -

較複雜的例子 : 一個人多筆項目資料合併成一筆

chartno ALB

Alpha-Fetopro

teinALT Anti-HBs

Anti-Hepatitis C Virus

Anti-HIV screening(EIA)

0688522

4.7 3.60 34Non-

reactive(0.0)

Non-reactive(0.05)

　

0731146

4.4 　 14Non-

reactive(0.0)

Non-reactive(0.06)

　

0816764

4.4 　 13Reactive(8

4.61)

Non-reactive(0.16)

　

0970097

4.6 　 16Reactive(9

0.64)

Non-reactive(0.16)

　

Sub Rearrange()Dim I, J, M, N As IntegerI = 2 ' row number of sheet 1M = 1 ' row number of sheet 2N = 1 ' column number of sheet 2Worksheets(1).Select ' original sheet the first recordoldID = ""ID = Range("A" & I).ValueItem = Range("B" & I).ValueValue1 = Range("C" & I).Value

Do While ID <> "" Worksheets(2).Select ' new sheet N = 1 If ID = oldID Then 'the same person Do While Item <> Cells(1, N) 'check the item equal or not N = N + 1 ' not equal, then next column Loop Cells(M, N) = Value1 ' equal item, write it

Else 'next person M = M + 1 ' write a new record to new sheet Cells(M, N) = ID Do While Item <> Cells(1, N) N = N + 1 Loop Cells(M, N) = Value1 End If

Worksheets(1).Select 'original sheet get next record oldID = ID I = I + 1 ID = Range("A" & I).Value Item = Range("B" & I).Value Value1 = Range("C" & I).ValueLoopEnd Sub