VBAの考え方：エクセルのカソールの移動制御(No.2)

すみません。
下記の様に、データ入力後のセルを動かせるVBAを考えています。
この動きは１回分で、次はF20から始まります。
F10,H10,F11,H11,O10,Q10,O11,Q11,X10,Z10,X11,Z11,AG10,AI10,AG11,AI11,AP10,AR10,AP11,AR11,AZ10,BC10,AZ11,BC11,
F12,H12,F13,H13,O12,Q12,O13,Q13,X12,Z12,X13,Z13,AG12,AI12,AG13,AI13,AP12,AR12,AP13,AR13,AZ12,BC12,AZ13,BC13,
F14,H14,F15,H15,O14,Q14,O15,Q15,X14,Z14,X15,Z15,AG14,AI14,AG15,AI15,AP14,AR14,AP15,AR15,AZ14,BC14,AZ15,BC15,
F16,H16,F17,H17,O16,Q16,O17,Q17,X16,Z16,X17,Z17,AG16,AI16,AG17,AI17,AP16,AR16,AP17,AR17,AZ16,BC16,AZ17,BC17,
F18,H18,F19,H19,O18,Q18,O19,Q19,X18,Z18,X19,Z19,AG18,AI18,AG19,AI19,AP18,AR18,AP19,AR19,AZ18,BC18,AZ19,BC19,

アドバイスをお願いいたします。

質問者からの補足コメント

• 早速の連絡ありがとうございます。
  勉強します。ちょっと待ってください。

  No.2の回答に寄せられた補足コメントです。 補足日時：2015/02/12 21:56

• 早速の連絡ありがとうございます。
  勉強します。ちょっと待ってください。

  No.1の回答に寄せられた補足コメントです。 補足日時：2015/02/12 21:56

No.3 ベストアンサー 回答者： cj_mover 回答日時： 2015/02/15 07:32

＃１-２です。

補足・お礼、拝見しました。

> 自分なりに理解に努力しましたが、難しいので理解できませんでした。
> でも、少しずつ出来るよう続けていこうと思います。
ということなので、少しでも理解の援けになるよう解説を書いてみました。
また、少しでも解り易いものになるよう、再度書き換えました（動作仕様は全く一緒）。
すぐに解ろうとしないでも、少しずつ、時間が経てば深まるものに期待していていいです。
無理して返事しないで構いませんから、またいつかここで、お会いしましょう。

前提として、相対参照の仕方を確認してみて下さい。
　　Range("A10").Range("F1").Select　'　→　F10　を選択
　　Range("A10").Range("H2").Select　'　→　H11
　　Range("A10").Range("BC2").Select　'　→　BC11
　　Range("A12").Range("F1").Select　'　→　F12
　　Range("A12").Range("H2").Select　'　→　H13
　　Range("A12").Range("BC2").Select　'　→　BC13

上の相対参照の例に照らして考えると、
'10''12'　の部分を
Dim nLevelRow As Long　'　各ブロック毎の相対参照基準行位置（10,12,14,...）"F11"なら10,"BC11"なら10→12
で表現します。
"F1"H1""BC2"...　の部分を相対参照セルアドレスとして
' ' セル選択の順番を定義した内の筆頭にあるセルアドレス："F1"
Private sRelativeRefOrg As String
Dim sRelativeRefPrev As String　'　値変更されたセルのアドレス（'Ａ列基準行セル'への相対参照）
Dim sRelativeRefNext As String　'　次に選択するべきセルのアドレスを（'Ａ列基準行セル'への相対参照）
等のように表現しています。

処理の流れとしては、
F10（Range("A10").Range("F1")）の値が変更されたなら。
H10（Range("A10").Range("H1")）を選択する、という場合
"F1"を辞書で調べると"H1"が返ってくる、というようなこと（対応付け）
をする目的で、Dictinary（辞書）オブジェクトを使っています。

BC11（Range("A10").Range("BC2")）の値が変更されたなら。
F12（Range("A12").Range("F1")）を選択する、という場合
"BC2"を辞書で調べると"F1"が返ってくる。"F1"返ってきたら、
基準行位置（10）を次のブロックの基準行位置（12）に変更する。

技術的なポイントとしてその他、
イベントプロシージャ（Worksheet_Change）の基本的な扱い
配列変数やSplit関数の基本的な扱い
等もチェックしてみて下さい。

以下、差し替えてお使い下さい。

' ' ///
Option Explicit

' '　' 相対参照で　セル選択の順番を定義（配列の元データ）（セル範囲参照文字列）
Const SREF = "F1,H1,F2,H2,O1,Q1,O2,Q2,X1,Z1,X2,Z2,AG1,AI1,AG2,AI2,AP1,AR1,AP2,AR2,AZ1,BC1,AZ2,BC2"

' ' 値変更されたセルアドレスを'Ａ列基準行セル'への相対参照で渡すと、
' ' 次に選択するべきセルのアドレスを'Ａ列基準行セル'への相対参照で返す
' ' Dictinary（辞書）オブジェクト
Private oDict As Object　'　Scripting.Dictionary

' ' セル選択の順番を定義した内の筆頭にあるセルアドレス："F1"
' ' （次に選択するべき相対参照セルアドレスが"F1"に一致したならば、
' ' 　基準行位置を次のブロックの基準行位置に変更する為に必要）
Private sRelativeRefOrg As String

Private Sub Worksheet_Change(ByVal Target As Range)　'　値変更時に発生するイベント
Dim arrRelativeRef() As String　'　定義されたセル選択の順番を格納する配列（相対参照のアドレス）
Dim sRelativeRefPrev As String　'　値変更されたセルのアドレス（'Ａ列基準行セル'への相対参照）
Dim sRelativeRefNext As String　'　次に選択するべきセルのアドレスを（'Ａ列基準行セル'への相対参照）
Dim nLevelRow As Long　'　各ブロック毎の相対参照基準行位置（10,12,14,...）"F11"なら10,"BC11"なら10→12
Dim nUBound As Long　'　配列の大きさ（要素数より１少ない数）
Dim i As Long　'　ループ用

　　If Target.Count > 1 Then Exit Sub　'　値変更されたセルの数が１より大きければ処理を抜ける
　　If Target.Row < 10 Then Exit Sub　'　値変更されたセルの行位置が１０未満ならば処理を抜ける
　　' ' 値変更されたセルが定義されたセルの列に該当しなければ処理を抜ける
　　If Intersect(Target, Range(SREF).EntireColumn) Is Nothing Then Exit Sub

　　' ' Dictinary（辞書）オブジェクトが未設定なら（初めてこの記述を実行する時）
　　' ' Dictinary（辞書）オブジェクトの実体を作成し、格納する
　　' ' F1→H1,H1→F2,F2→H2,...BC2→（次のブロックの）F1、のように対応関係を呼び出す為のもの
　　If oDict Is Nothing Then
　　　　Set oDict = CreateObject("Scripting.Dictionary")　'　インスタンス生成
　　　　arrRelativeRef() = Split(SREF, ",")　'　定義されたセル選択の順番（相対参照のアドレス）を配列に格納
　　　　' ' セル選択の順番を定義した内の筆頭にあるセルアドレス："F1"
　　　　' ' （次に選択するべき相対参照セルアドレスが"F1"に一致したならば、
　　　　' ' 　基準行位置を次のブロックの基準行位置に変更する為に必要）
　　　　sRelativeRefOrg = arrRelativeRef(0)
　　　　nUBound = UBound(arrRelativeRef())　'　配列の大きさ（要素数より１少ない数）
　　　　For i = 0 To nUBound - 1
　　　　　　oDict(arrRelativeRef(i)) = arrRelativeRef(i + 1)　'　辞書に追加　F1→H1,H1→F2,F2→H2,...
　　　　Next i
　　　　oDict(arrRelativeRef(nUBound)) = arrRelativeRef(0)　' 辞書に追加　 BC2→（次のブロックの）F1
　　End If

　　' ' 値変更されたセルの行位置を取得して偶数に丸める（10→10,11→10,11→11,12→11,...）
　　nLevelRow = Target.Row And Not 1　'　　各ブロック毎の相対参照基準行位置
　　' ' 値変更されたセルの'基準行位置'分上のセルのアドレスを相対参照として取得
　　sRelativeRefPrev = Target.Offset(1 - nLevelRow).Address(0, 0)

　　' ' 値変更されたセルの相対参照アドレスが辞書に登録されていなければ処理を抜ける
　　If Not oDict.Exists(sRelativeRefPrev) Then Exit Sub

　　' ' 辞書を参照して、
　　' ' 値変更されたセルの相対参照アドレス　に対応した
　　' ' 次に選択するべき相対参照セルアドレス　を取得
　　sRelativeRefNext = oDict(sRelativeRefPrev)

　　' ' 次に選択するべき相対参照セルアドレスが"F1"に一致したならば、
　　' ' 基準行位置を次のブロックの基準行位置（２行下）に変更する
　　If sRelativeRefNext = sRelativeRefOrg Then nLevelRow = nLevelRow + 2

　　Application.EnableEvents = False　'　Worksheet_SelectionChangeイベントを発生させないように抑止
　　' ' 'Ａ列基準行セル'　からみて
　　' ' 次に選択するべき相対参照セルアドレス　の位置にあるセルを選択する
　　Cells(nLevelRow, "A").Range(sRelativeRefNext).Select
　　Application.EnableEvents = True　'　イベント再開
End Sub

この回答へのお礼

お早うございます。
朝早くからありがとうございます。
今日は休みなので、眺めてみます。
こころ遣い嬉です。またいつかここで、お会いしましょう。

お礼日時：2015/02/15 09:12

No.2 回答者： cj_mover 回答日時： 2015/02/12 03:43

＃１です。

自己レスです。

誤って、動作確認していたものとは違う版を掲げてしまいました。
すみませんが、差し替えをお願いします。失礼しました。

Option Explicit

Const SREF = "F1,H1,F2,H2,O1,Q1,O2,Q2,X1,Z1,X2,Z2,AG1,AI1,AG2,AI2,AP1,AR1,AP2,AR2,AZ1,BC1,AZ2,BC2"
Private oDict As Object　'　Scripting.Dictionary

Private Sub Worksheet_Change(ByVal Target As Range)
Dim s As String
Dim nRow As Long
Dim n As Long

　　If Target.Count > 1 Then Exit Sub
　　If Target.Row < 10 Then Exit Sub
　　If Intersect(Target, Range(SREF).EntireColumn) Is Nothing Then Exit Sub

　　nRow = Target.Row And Not 1　'　偶数に丸める　相対参照の基点となる行
　　s = Target.Offset(1 - nRow).Address(0, 0)　'　相対参照での参照文字列

On Error GoTo CrDict_
　　If Not oDict.Exists(s) Then Exit Sub　'　相対参照での参照文字列が定義した範囲でなければ抜け
On Error GoTo 0

　　n = oDict(s)
　　If n = 1 Then nRow = nRow + 2　'　２行単位の右下端セルの場合、２行スキップ

　　Application.EnableEvents = False
On Error Resume Next
　　Cells(nRow, "A").Range(SREF).Areas(n).Select　'　相対参照
On Error GoTo 0
　　Application.EnableEvents = True
Exit Sub

CrDict_:
Dim v
Dim arr
Dim i As Long
　　Set oDict = CreateObject("Scripting.Dictionary")
　　arr = Split(SREF, ",")
　　i = 1
　　For Each v In arr
　　　　i = i + 1
　　　　oDict(v) = i
　　Next
　　oDict(arr(UBound(arr))) = 1
Resume
End Sub

この回答へのお礼

見事なアドバイスありがとうございます。
ストレス無く動きます。素晴らしいです。
自分なりに理解に努力しましたが、難しいので理解できませんでした。
でも、少しずつ出来るよう続けていこうと思います。
ありがとうございました。m(__)m

お礼日時：2015/02/14 22:26

No.1 回答者： cj_mover 回答日時： 2015/02/12 03:13

こんにちは。

対象シートの【シートモジュールの先頭】に
下の記述を貼り付けてください。
Worksheet_Change イベントですので、
セルが入力モードになった後に確定したタイミングで動きます。
ただEnterキーを押しただけでは、機能しませんのでご注意を。
ただ順番に、というだけでなく、どこから始めても
定義してある次のセルを選択するように書いてあります。
簡単ではありますが一応、動作は確認しています。

法則性みたいのがあるのだとすると、
> ,AZ10,BC10,AZ11,BC11
は、これだけが特異なので、
,AY10,BA10,AY11,BA11
なのかな？と思ったりしますが、念の為そちらで、確認の上、
必要なら、下記の ,AZ1,BC1,AZ2,BC2 の部分を修正してください。

説明した方がいいのでしょうけれど、厚量過ぎて難しいと思って、
とりあえず、何も書いてません。
疑問や、不足があった場合にはお応えしますので、補足欄にでも書いて下さい。

Option Explicit

Const SREF = "F1,H1,F2,H2,O1,Q1,O2,Q2,X1,Z1,X2,Z2,AG1,AI1,AG2,AI2,AP1,AR1,AP2,AR2,AZ1,BC1,AZ2,BC2"
Private oDict As Object　'　Scripting.Dictionary

Private Sub Worksheet_Change(ByVal Target As Range)
Dim s As String
Dim nRow As Long
Dim n As Long
　　If Target.Count > 1 Then Exit Sub
　　If Target.Row < 10 Then Exit Sub
　　If Intersect(Target, Range(SREF).EntireColumn) Is Nothing Then Exit Sub
　　
　　nRow = Target.Row And Not 1　'　偶数に丸める
　　s = Target.Offset(1 - nRow).Address(0, 0)

On Error GoTo CrDict_
　　If oDict.Exists(s) Then
On Error GoTo 0

　　　　n = oDict(s)
　　　　If n = 1 Then nRow = nRow + 2

　　　　Application.EnableEvents = False
On Error Resume Next
　　　　Cells(nRow, "A").Range(SREF).Areas(n).Select
On Error GoTo 0
　　　　Application.EnableEvents = True
　　End If
Exit Sub

CrDict_:
Dim v
Dim arr
Dim i As Long
　　Set oDict = CreateObject("Scripting.Dictionary")
　　arr = Split(SREF, ",")
　　i = 1
　　For Each v In arr
　　　　i = i + 1
　　　　oDict(v) = i
　　Next
　　oDict(arr(UBound(arr))) = 1
Resume
End Sub