エクセルVBA セルの移動について

質問

今困っているのですが、A1～A8のセルに”あ”もしくは”い”が入ったときにB1のセルにとあるセルのリストを入力規制かけて、表示させるというVBAを作成中です。
と・・・そこまではできたのですが、希望としては、A1に文字が入った場合はセルを自動的にB1に移動させたいのです。
それと同じようにA2のときはB2、A3のときはB3にセルを持って行きたいのですが、どうしたらいいでしょうか。
どなたかわかる方、よろしくお願いいたします。

For i = 1 To 8
Select Case Cells(i, 1)
Case "あ"

Cells(i, 2).Activate
Application.CutCopyMode = False
With Selection.Validation
.Delete
.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
xlBetween, Formula1:="=$F$1:$F$10"
.IgnoreBlank = True
.InCellDropdown = True
.InputTitle = ""
.ErrorTitle = ""
.InputMessage = ""
.ErrorMessage = ""
.IMEMode = xlIMEModeNoControl
.ShowInput = True
.ShowError = True
End With

Case "い"

Selection.Cells(i, 2).Activate
CutCopyMode = False
With Selection.Validation
.Delete
.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
xlBetween, Formula1:="=$G$1:$G$10"
.IgnoreBlank = True
.InCellDropdown = True
.InputTitle = ""
.ErrorTitle = ""
.InputMessage = ""
.ErrorMessage = ""
.IMEMode = xlIMEModeNoControl
.ShowInput = True
.ShowError = True
End With
Enxt
End Sub

回答No.3

MSZ006 · ベストアンサー

これでどうでしょうか？

Private Sub Worksheet_Change(ByVal Target As Range)
Dim i As Integer
Dim rg As Range
Dim sw As Boolean

sw = False

For i = 1 To 8
If Target.Address = Cells(i, 1).Address Then
Cells(i, 2).Activate
Set rg = Cells(i, 2)
sw = True
End If
Next i

If sw = False Then Exit Sub

Select Case Target
Case "あ"

rg.Activate
CutCopyMode = False
With Selection.Validation
.Delete
.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
xlBetween, Formula1:="=$F$1:$F$10"
.IgnoreBlank = True
.InCellDropdown = True
.InputTitle = ""
.ErrorTitle = ""
.InputMessage = ""
.ErrorMessage = ""
.IMEMode = xlIMEModeNoControl
.ShowInput = True
.ShowError = True
End With

Case "い"

rg.Activate
CutCopyMode = False
With Selection.Validation
.Delete
.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
xlBetween, Formula1:="=$G$1:$G$10"
.IgnoreBlank = True
.InCellDropdown = True
.InputTitle = ""
.ErrorTitle = ""
.InputMessage = ""
.ErrorMessage = ""
.IMEMode = xlIMEModeNoControl
.ShowInput = True
.ShowError = True
End With

Case Else

rg.Activate
CutCopyMode = False
With Selection.Validation
.Delete
.Add Type:=xlValidateInputOnly, AlertStyle:=xlValidAlertStop, Operator _
:=xlBetween
.IgnoreBlank = True
.InCellDropdown = True
.InputTitle = ""
.ErrorTitle = ""
.InputMessage = ""
.ErrorMessage = ""
.IMEMode = xlIMEModeNoControl
.ShowInput = True
.ShowError = True
End With

End Select

End Sub

これをシート名のところを右クリック「ソースの表示」で表示されるソースを記述するウインドウにコピペしてみてください。

お礼

うわ～　ありがとうございます！！　完璧です！！
これでやっと望むものが出来そうです。本当にありがとうございました

回答No.4

MSZ006

＃３ですが、回答の最後のほう「ソースの表示」ではなくて「コードの表示」でした。すみません。

回答No.2

MSZ006

このようなものでどうでしょうか？

Private Sub Worksheet_Change(ByVal Target As Range)
　Dim i As Integer

　For i = 1 To 8
　　If Target.Address = Cells(i, 1).Address Then
　　　Cells(i, 2).Activate
　　End If
　Next

End Sub

お礼

すいません　それについてもう少し質問なんですが、
この構文を、どの辺につけたらうまく行くでしょうか。
いろいろ試したんですけど、For～Nextの間でやっぱりA1へ入力してもB2へ移動してしますんです。一瞬はB1へ移動するのは見えるんですけどね；；

補足

A1へ入力したらA8でした。すいません

回答No.1

norakuma

それぞれのCaseの一番下の

end with
の下の行に

Selection.Cells(i, 3).Activate
じゃだめですかね？

試してないけど。