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 · ベストアンサー

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殿
ご回答くださり、ありがとうございます。
早速試してみたところ、希望通りの動きをしてくれました。

回答No.4

DexMachina

> 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殿
ご回答ありがとうございます。
無事、ファイルを作成することができました。

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

回答No.3

freetaka

うぎゃ・・・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殿
ご回答、ありがとうございます。
なんとかファイルを作り直すことができました。

回答No.2

freetaka

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