excel マクロ 「select case」への条件盛り込み方法について

初めまして。

仕事にて、EXCELに工程遅延の原因を記入しているのですが、
同じ理由(約50種類あります)を何度も記入する必要があるため、
理由ごとに番号を割り振って、ボタン一つで記入できるようにしたいと思っています。

そこで、下記のようにマクロを作成してみたのですが、
現状では、例えばCells(1, 1)に何かを特記していた場合、
記入後にこのマクロを実行してしまうと、Cells(1, 1)の特記が、
上書きにより消えてしまいます。

そこで、Cells(num, 1)が空白であれば、Cells(num, 1)に上書きする、
という条件を付加したいのですが、可能でしょうか。

EXCELマクロの本を参考に作成しているのですが、
組み合わせの方法が分かりません。

お時間がある方いらっしゃいましたら、
ご検討よろしくお願い致します。

Sub 理由挿入()
Dim num As Integer
For num = 1 To 100
Select Case Cells(num, 2).Value
Case 1
Cells(num, 1).Value = "理由１"
Case 2
Cells(num, 1).Value = "理由２"
Case 3
Cells(num, 1).Value = "理由３"
Case 4
Cells(num, 1).Value = "理由４"
End Select
Next
End Sub

No.1 ベストアンサー 回答者： okormazd 回答日時： 2009/10/18 20:55

Sub 理由挿入()

Dim num As Integer
For num = 1 To 100
If Cells(num, 1).Value = "" Then
Select Case Cells(num, 2).Value
Case 1
Cells(num, 1).Value = "理由１"
Case 2
Cells(num, 1).Value = "理由２"
Case 3
Cells(num, 1).Value = "理由３"
Case 4
Cells(num, 1).Value = "理由４"
End Select
End If
Next
End Sub
でいいんじゃないか。

この回答へのお礼

okormazd殿
ご回答くださり、ありがとうございます。
早速試してみたところ、希望通りの動きをしてくれました。

お礼日時：2009/10/18 21:19

No.4 回答者： DexMachina 回答日時： 2009/10/18 21:01

> EXCELマクロの本を参考に作成しているのですが、

> 組み合わせの方法が分かりません。

Select Caseの中に、更にIfやSelect Caseを入れられます。
以下は、Cells(i, 1)が空白でない場合は改行をして同じセルに
追記する場合のサンプルです。
(セルに記録する値を、一旦変数で受ける形にしました)

Sub 理由挿入()

　　Dim i As Integer, Val1 As String, Val2 As String

　　For i = 1 To 100
　　　　Val1 = Cells(i, 1)
　　　　Val2 = Cells(i, 2)
　　　　Select Case Val2
　　　　　　Case 1
　　　　　　　　'If文を入れ子にする例(1)
　　　　　　　　If Val1 = "" Then
　　　　　　　　　　Val1 = "理由1"
　　　　　　　　Else
　　　　　　　　　　Val1 = Val1 & vbCrLf & "理由1"
　　　　　　　　End If
　　　　　　Case 2
　　　　　　　　'If文を入れ子にする例(2)
　　　　　　　　If Val1 = "" Then Val1 = "理由2" & Val1 = Val1 & vbCrLf & "理由2"
　　　　　　Case 3
　　　　　　　　'IIF関数を使用する例
　　　　　　　　Val1 = IIF(Val1 = "", "", Val1 & vbCrLf) & "理由3"
　　　　　　Case 4
　　　　　　　　'Select Case を入れ子にする例
　　　　　　　　Select Case Val1
　　　　　　　　　　Case ""
　　　　　　　　　　　　Val1 = "理由4"
　　　　　　　　　　Case Else
　　　　　　　　　　　　Val1 = Val1 & vbCrLf & "理由4"
　　　　　　　　End Select
　　　　End Select
　　　　'変数に記録した値でセルを上書き
　　　　Cells(i, 1) = Val1
　　Next

End Sub

この回答へのお礼

DexMachina殿
ご回答ありがとうございます。
無事、ファイルを作成することができました。

丁寧にご記入くださったのに、ポイントを差し上げることができず、
申し訳ございません。

お礼日時：2009/10/18 21:25

No.3 回答者： freetaka 回答日時： 2009/10/18 20:59

うぎゃ・・・End Ifの位置をまちがった^-^;

Sub 理由挿入()
Dim num As Integer
For num = 1 To 100

If Cells(num,1) = "" Then
Select Case Cells(num, 2).Value
Case 1
Cells(num, 1).Value = "理由１"
Case 2
Cells(num, 1).Value = "理由２"
Case 3
Cells(num, 1).Value = "理由３"
Case 4
Cells(num, 1).Value = "理由４"
End Select
End If
Next
End Sub

この回答へのお礼

freetaka殿
ご回答、ありがとうございます。
なんとかファイルを作り直すことができました。

お礼日時：2009/10/18 21:23

No.2 回答者： freetaka 回答日時： 2009/10/18 20:57

IF文で空白の時だけSelect文を実行するようにすれば

処理可能です

Sub 理由挿入()
Dim num As Integer
For num = 1 To 100

If Cells(num,1) = "" Then
Select Case Cells(num, 2).Value
Case 1
Cells(num, 1).Value = "理由１"
Case 2
Cells(num, 1).Value = "理由２"
Case 3
Cells(num, 1).Value = "理由３"
Case 4
Cells(num, 1).Value = "理由４"
End Select
Next
End If
End Sub