Excel VBA 勉強メモ(変数と制御構造)

  • テキストは、FOMの 「Excel2002マクロ/VBA入門」。
  • 以下のプロシージャは、自分でアレンジしたもの。
  • 動作確認は、Excel2003にて。

IF

Sub 計算結果を指定セルに表示()
Dim tanka As Integer ’tankaを変数宣言(整数型として)
Dim kazu As Integer
Dim uriage As Integer
tanka = Range(“c12”).Value
kazu = Range(“e12”).Value
uriage = tanka * kazu
Range(“g12”).Select
ActiveCell.Value = uriage
End Sub

Sub 計算結果をメッセージボックスに表示()
Dim i As Integer
i = 10 * 10
MsgBox i
End Sub

Sub 文字列をセルに表示()
Dim i As String
i = “こんにちは”
ActiveCell.Value = i
End Sub

Sub インプットボックスで県名を入力()
Dim ken As String
ken = InputBox(“県名を入力してください”, “所在地”)
ActiveCell.Value = ken
End Sub

Sub 合否判定() ’If~Then
Dim tokuten As Integer
Dim kijun As Integer
tokuten = Range(“e11”).Value
kijun = Range(“c11”).Value
If tokuten >= kijun Then
Range(“g11”).Select
ActiveCell.Value = “合格”
End If
End Sub

Sub 合否判定2() ’If~Then~Else
Dim tokuten As Integer
Dim kijun As Integer
tokuten = Range(“e19”)
kijun = Range(“c19”)
If kijun <= tokuten Then MsgBox "合格です。おめでとう!" Else MsgBox "不合格です。次に期待!" End If End Sub Sub 合否判定3() ’If~Then~ElseIf
Dim tokuten As Integer
tokuten = Range(“c35”).Value
Range(“e35”).Select
If tokuten >= 80 Then
ActiveCell.Value = “合格”
ElseIf tokuten >= 60 And tokuten <= 79 Then ActiveCell.Value = "追試" ElseIf tokuten <= 59 Then ActiveCell.Value = "不合格" End If End Sub Sub 寿司の価格() ‘If文のネスト
Dim rank As String ‘松竹梅
Dim kazu As Integer ‘何人前か
kazu = Range(“d41”)
Range(“e41”).Select
If Range(“c41”).Value = “梅” Then
If kazu = 1 Then
ActiveCell.Value = 1000 ‘梅1人前1,000円
ElseIf kazu = 2 Then
ActiveCell.Value = 1800
End If
ElseIf Range(“c41”).Value = “竹” Then
If kazu = 1 Then
ActiveCell.Value = 2000
ElseIf kazu = 2 Then
ActiveCell.Value = 3700
End If
ElseIf Range(“c41”).Value = “松” Then
If kazu = 1 Then
ActiveCell.Value = 3000
ElseIf kazu = 2 Then
ActiveCell.Value = 5500
End If
End If
End Sub

Sub 福引()
Dim iro As String
iro = Range(“c11”)
Range(“d11”).Select
If iro = “金” Then
ActiveCell.Value = “特等”
End If
If iro = “赤” Then
ActiveCell.Value = “一等”
End If
If iro = “青” Then
ActiveCell.Value = “二等”
End If
If iro = “黄” Then
ActiveCell.Value = “三等”
End If
If iro = “緑” Then
ActiveCell.Value = “四等”
End If
End Sub

case

Sub 福引2()
Dim atari As String
Select Case Range(“c11”).Value
Case Is = “金”
atari = “特等”
Case Is = “赤”
atari = “一等”
Case Is = “青”
atari = “二等”
Case Is = “黄”
atari = “三等”
Case Is = “緑”
atari = “四等”
End Select
MsgBox atari
End Sub

Sub 合格発表()
Dim goukaku As String
Select Case Range(“c20”).Value
Case 8, 21, 25, 26, 31
goukaku = “合格”
Case 15, 35
goukaku = “補欠合格”
Case Else
goukaku = “不合格”
End Select
MsgBox goukaku
End Sub

Sub 少子化対策()
Dim hojo As Integer
Select Case Range(“c27”).Value
Case Is >= 10
hojo = 20000 ’10人以上の場合は、一人につき2万円の補助
Case 5 To 9
hojo = 15000
Case 2 To 4
hojo = 10000
Case Is = 1
hojo = 5000
End Select
MsgBox hojo * Range(“c27”) ‘人数分の補助金を算出
End Sub

Sub 文字色の設定()
Dim fontcolor As String
fontcolor = Range(“c35”).Value
Range(“c35”).Select
Select Case fontcolor
Case “赤”
ActiveCell.Font.ColorIndex = 3
Case “青”
ActiveCell.Font.ColorIndex = 5
Case “桃”
ActiveCell.Font.ColorIndex = 7
Case “緑”
ActiveCell.Font.ColorIndex = 10
Case Else
MsgBox “赤、青、桃、緑のいずれかを入力してください”
End Select
End Sub

For~Next

Sub 番長皿屋敷()
Dim i As Integer
For i = 1 To 9
MsgBox i & “枚~”
Next
MsgBox “1枚足りない・・・”
End Sub

Sub 百までの偶数を表示()
Dim i As Integer
For i = 2 To 100 Step 2 ‘2から100まで。2ずつ増加
ActiveCell.Value = i
ActiveCell.Offset(1, 0).Select 選択されたセルから下へ1ずつ
Next
End Sub

Sub ワークシートの削除()
Dim i As Integer
For i = Worksheets.Count To 7 Step -1 ‘ワークシートを右端から1つずつ削除し、ワークシート全体の数が7になるまで繰り返す
Worksheets(i).Delete
Next
End Sub

Sub ForNextのネスト()
Dim i As Integer
Dim n As Integer
For i = 1000 To 2000 Step 1000
For n = 1 To 3
MsgBox i
MsgBox n
Next n
Next i
End Sub

Sub 爆弾セルでゲームオーバー() ‘Do While ~ Loop (爆弾マークになるまで繰り返す)
Dim i As Integer
i = 1
Range(“c10”).Select
Do While ActiveCell.Value <> “●~*” ‘判断条件がループ条件の最初にある=開始セルは空白であってはならない
MsgBox i & “回”
i = i + 1
ActiveCell.Offset(0, 1).Select
Loop
MsgBox “ゲームオーバー” ‘爆弾マーク時のメッセージ
End Sub

Sub 百回目のプロポーズ() ‘Do ~ Loop While (にこにこマークになるまで繰り返す)
Dim i As Integer
i = 1
Range(“c16”).Select
Do
MsgBox i & “回目のプロポーズ”
i = i + 1
ActiveCell.Offset(0, 1).Select
Loop While ActiveCell.Value <> “(*^^*)” ‘判断条件がループ条件の最後にある=開始セルが空白でも処理を行う
MsgBox “喜んで!” ‘にこにこマーク時のメッセージ
End Sub

Sub 得点表示() ‘Do Until~Loop(国語のクラス平均は66点です。あなたの点数は30点です。英語の、と繰り返す)
Range(“c23”).Select
Do Until ActiveCell.Value = “”
MsgBox ActiveCell.Offset(-2, 0).Value & “のクラス平均は” & ActiveCell.Offset(-1, 0).Value & “点。あなたの得点は” & ActiveCell.Value & “点です。”
ActiveCell.Offset(0, 1).Select
Loop
End Sub

Sub 連続したセルに書式設定を自動設定()
Range(“c32”).Select
Do
ActiveCell.Font.Bold = True
ActiveCell.Font.Italic = True
ActiveCell.Interior.ColorIndex = 7
ActiveCell.Offset(0, 1).Select
Loop Until ActiveCell.Value = “”
End Sub