select case文について

質問

リストから選択とリストに無い値の入力のリストへの追加をしたく、あちこちの情報をつぎはぎで下記のようにVBAで動かそうとしましたが、うまく動いてくれません。
前（Case A）は動くのですが、あと（Case 2）が機能しません。
それと、3つ以上をSelectCaseで組む場合の方法も合わせてお願いします。

Private Sub Worksheet_Change(ByVal Target As Range)
Dim c As Range
Dim LastR As Long
Select Case Target.Address(0, 0)
Application.EnableEvents = False
Case "D1"
With Worksheets("Sheet2")
LastR = .Range("A36636").End(xlUp).Row
Set c = .Range("A1:A" & LastR).Find( _
Target.Value, , xlValues, xlWhole, xlByColumns, xlPrevious, True)
If c Is Nothing Then
If vbNo = MsgBox("リストに追加しますか？", _
vbYesNo, "追加の確認") Then
Application.EnableEvents = True
Exit Sub
End If
.Range("A" & LastR + 1).Value = Target.Value
.Range("A1:A" & LastR + 1).Name = "リストA"
End If
With Target.Validation
.Delete
.Add Type:=xlValidateList, Formula1:="=リストA"
.ShowError = False
End With

Case "E1"
With Worksheets("Sheet2")
Set c = .Range("B1:B" & LastR).Find( _
Target.Value, , xlValues, xlWhole, xlByColumns, xlPrevious, True)
If c Is Nothing Then
If vbNo = MsgBox("リストに追加しますか？", _
vbYesNo, "追加の確認") Then
Application.EnableEvents = True
Exit Sub
End If
.Range("B" & LastR + 1).Value = Target.Value
.Range("B1:B" & LastR + 1).Name = "リストB"
End If
End Select
End With
With Target.Validation
.Delete
.Add Type:=xlValidateList, Formula1:="=リストB"
.ShowError = False
End With
Application.EnableEvents = True
End Sub

回答No.1

Kuppycat · ベストアンサー

Private Sub Worksheet_Change(ByVal Target As Range)
Dim c As Range
Dim LastR As Long

Application.EnableEvents = False
Select Case Target.Address(0, 0)
Case "D1"
With Worksheets("Sheet2")
LastR = .Range("A36636").End(xlUp).Row
Set c = .Range("A1:A" & LastR).Find( _
Target.Value, , xlValues, xlWhole, xlByColumns, xlPrevious, True)
If c Is Nothing Then
If vbNo = MsgBox("リストに追加しますか？", vbYesNo, "追加の確認") Then
Application.EnableEvents = True
Exit Sub
End If
.Range("A" & LastR + 1).Value = Target.Value
.Range("A1:A" & LastR + 1).Name = "リストA"
End If
End With
With Target.Validation
.Delete
.Add Type:=xlValidateList, Formula1:="=リストA"
.ShowError = False
End With
Case "E1"
With Worksheets("Sheet2")
Set c = .Range("B1:B" & LastR).Find( _
Target.Value, , xlValues, xlWhole, xlByColumns, xlPrevious, True)
If c Is Nothing Then
If vbNo = MsgBox("リストに追加しますか？", vbYesNo, "追加の確認") Then
Application.EnableEvents = True
Exit Sub
End If
.Range("B" & LastR + 1).Value = Target.Value
.Range("B1:B" & LastR + 1).Name = "リストB"
End If
End With
With Target.Validation
.Delete
.Add Type:=xlValidateList, Formula1:="=リストB"
.ShowError = False
End With
End Select
Application.EnableEvents = True
End Sub

が正しいかと。

Select Case 条件対象
Case 条件１
　条件１の処理
Case 条件２
　条件２の処理
・
・
Case 条件ｎ
　条件ｎの処理
Case Else
　それ以外の処理
End Select
条件に複数該当する場合、上に書かれているほうが適用されます。

あと、Withはネストできなかったと思います。
With A
　.hogehoge
　With B
　　.hogehoge
　End With
End With
こういう書き方はＮＧ。

回答No.2

BellBell

とりあえずの問題点は、『With Worksheets("Sheet2")』がSelect Case 内に書かれていて、『End With』が外に書かれているところですね。
Case 分岐の最後にEnd With で括るか、この場合であればSelect Case 前に『With Worksheets("Sheet2")』を書く(それぞれのCase内の『With Worksheets("Sheet2")』は削除)ことですね。
Withは条件分岐(IfやSelect)の中と外、でWith ～ End Withはできません。
中と中、外と外であれば問題なし。
ちなみに、Withはネストできますよ。＜#1