VBA Integer 2 Bytes Long 4 Bytes Single

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

三. 程式流程控制基本指令 選擇結構 – 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

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). Value Do While AA <> "" If I Mod 2 <> 0 Then Rows(I). Interior. Color. Index = 3 End If I=I+1 AA = Range("A" & I). Value Loop End Sub

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

ID Name A 123456789 Alex A 123456790 Test A 123456791 Test A 123456793 Good A 123456794 Tom A 123456795 Tom A 123456796 Tom A 123456797 Tom Address TEL

兩個key都相同才刪 需先排序兩個key Sub delsame() Dim I As Integer I=2 Worksheets(2). Select AA = Range("A" & I). Value BB = Range("B" & I). Value I=I+1 Do 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 If Loop End Sub

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

多頁的明細資料匯總成一頁總表 Sub ALL() Dim i, j As Integer Dim sh As String i = 5 'Row beginning in TOTAL sheet For N = 1 To 5 'You must enter how many Sheet? sh = "sheet" & N Worksheets(sh). Select Value 1 = Range("G 2"). Value 2 = Range("D 2"). Value 3 = Range("L 2"). Value Worksheets("TOTAL"). Select ' TOTAL sheet Range("A" & i). Value = N Range("B" & i). Value = Value 1 Range("C" & i). Value = Value 2 Range("D" & i). Value = Value 3 i=i+1 Next End Sub

矩陣相乘的程式碼 Sub Array_Mult() Dim i, j, k, temp As Integer Worksheets(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 i Next k End Sub

Char t Item. Name N o Value 1 0688 5 ALB 2 2 4. 7 0688 Alpha 5 Fetoprot 3. 60 2 ein 2 0688 5 ALT 2 2 34 0688 5 Anti-HBs 2 2 Nonreactive(0. 0) 0688 Anti- Non-

較複雜的例子: 一個人多筆項目資料合併成一筆 chartno ALB Alpha. ALT Fetoprotein Anti-Hepatitis C Virus 0688522 4. 7 3. 60 0731146 4. 4 14 Nonreactive(0. 0) reactive(0. 06) 0816764 4. 4 13 Reactive(84. 61) Nonreactive(0. 16) 0970097 4. 6 16 Reactive(90. 64) Nonreactive(0. 16) Anti-HBs 34 Nonreactive(0. 0) reactive(0. 05) Anti-HIV screening (EIA)

Sub Rearrange() Dim I, J, M, N As Integer I = 2 ' row number of sheet 1 M = 1 ' row number of sheet 2 N = 1 ' column number of sheet 2 Worksheets(1). Select ' original sheet the first record old. ID = "" ID = Range("A" & I). Value Item = Range("B" & I). Value 1 = Range("C" & I). Value Do While ID <> "" Worksheets(2). Select ' new sheet N=1 If ID = old. ID 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) = Value 1 ' 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) = Value 1 End If Worksheets(1). Select 'original sheet get next record old. ID = ID I=I+1 ID = Range("A" & I). Value Item = Range("B" & I). Value 1 = Range("C" & I). Value Loop End Sub