エクセルvba 決まった行数毎に同じ処理を繰り返し

質問

excelマクロの質問です。
勉強も兼ねてなのですが、以下のものを実現したいです。

処理したい値は、全てsheet1のA列にあります。
処理したいグループ（範囲）は、行数が変わることなく、連続して下方にsheet1に記載されています。1グループ、5行です。

グループが奇数のものは、
Sheet1の一番上のセルから「店」を削除してSheet2のA列に。
次のセルも「店」を削除して、Sheet2に貼った処理済みの先のセルの下に。
3つ目のセルは、「本」を削除して、Sheet2に貼った処理済みの先のセルの下に。
4つ目は、そのままコピペ。
5つ目は、「以上」をコピペして終わり。

グループが偶数のものは、
Sheet1の一番上のセルから「支」を削除してSheet2のA列に。
次のセルも「支」を削除して、Sheet2に貼った処理済みの先のセルの下に。
3つ目のセルは、「部」を削除して、Sheet2に貼った処理済みの先のセルの下に。
4つ目は、そのままコピペ。
5つ目は、「以上」をコピペして終わり。

としたいです。
奇数・偶数グループともに、開始セルに「-」があり、最終セルには「以上」があるため、これをキーにして、繰り返し処理が出来ないか？と考えているのですが、上手く出来ません。

お手数ですが、ご教示いただけますと幸いです。

回答No.3

kkkkkm · ベストアンサー

No.2の補足です。

グループ同士の途中に空きがあっても一定間隔でグループがあるのでしたら
たとえば7行間隔だとしたら
Sub Test2()ではなくSub Test()の
Step 5を Step 7に変更すれば対応できると思います。

回答No.4

imogasi

データ例を補足してほしい。
質問内容を、読者に理解してもらう為には、
データ例
（内容は模擬、データ数はバラエティに応じて少な目に）
を書くのは必須だろう。
ーー
質問者の自分の今の課題は、尾鰭の部分がついて、説明が長くなるのだろうが、VBAを使う上で、幹と葉の部分（事項）を区別できるように早くなれ。
それには
この質問の回答を得て、済んだとするのでなく、広くVBAでのやり方の話題（解説本やWEB記事で）どんなことを話題にして取り上げて説明しているかを、経験すべきだ。
ーー
また幹と葉を分けてVBAの質問をすべきだ。
　こんなにごたごた記述・説明されると、読んでもよく判らない。
場合分けの箇条書きの訓練でもしたらどうか？将来必須だろう。
フローチャートはここでは扱いにくいが、本当は必須の作業だ。そういうことも、判ってないようだ。
ーー
＞決まった行数毎に同じ処理を繰り返し
だけならFor 文のStepの書き方の問題でしかないのだが、その規則性を乱す要因を説明すべきだ。
あるいは、
For　Nextで繰り返すが、個別行ごとに処理を分ける（処理を飛ばす）条件をIF文で書くとか。
その条件に限って箇条書きでもして、質問するとか。

回答No.2

kkkkkm

よくわからない部分もありますが、以下で試してみてください。

どちらのシートも2行目から始めるとして

以下のように全て連続しているのでしたら
A1店A
A2
A3
A4
以上
A6支B
A7
A8
A9
以上

Sub Test()
Dim ws1 As Worksheet, ws2 As Worksheet
Dim mRow As Long
Dim gCnt As Long

Set ws1 = Sheets("Sheet1")
Set ws2 = Sheets("Sheet2")

For mRow = 2 To Cells(Rows.Count, "A").End(xlUp).Row Step 5
gCnt = gCnt + 1
If gCnt Mod 2 = 0 Then
'偶数の処理
ws2.Cells(mRow, "A").Value = Replace(ws1.Cells(mRow, "A").Value, "支", "")
ws2.Cells(mRow + 1, "A").Value = Replace(ws1.Cells(mRow + 1, "A").Value, "支", "")
ws2.Cells(mRow + 2, "A").Value = Replace(ws1.Cells(mRow + 2, "A").Value, "部", "")
ws2.Cells(mRow + 3, "A").Value = ws1.Cells(mRow + 3, "A").Value
ws2.Cells(mRow + 4, "A").Value = ws1.Cells(mRow + 4, "A").Value
Else
'奇数の処理 偶数と同じように
End If
Next
Set ws1 = Nothing
Set ws2 = Nothing

End Sub

以下のようにグループの途中で空きがある状態で「-」は一番上のセルの上に区切りとしてある場合でしたら
-
A1店A
A2
A3
A4
以上
空き
空き
-
A6支B
A7
A8
A9
以上

Sub Test2()
Dim ws1 As Worksheet, ws2 As Worksheet
Dim mRow As Long, mRow2 As Long
Dim gCnt As Long

Set ws1 = Sheets("Sheet1")
Set ws2 = Sheets("Sheet2")

mRow2 = 2
For mRow = 2 To Cells(Rows.Count, "A").End(xlUp).Row
If InStr(Cells(mRow, "A").Value, "-") > 0 Then
gCnt = gCnt + 1
If gCnt Mod 2 = 0 Then
'偶数の処理
ws2.Cells(mRow2, "A").Value = Replace(ws1.Cells(mRow + 1, "A").Value, "支", "")
ws2.Cells(mRow2 + 1, "A").Value = Replace(ws1.Cells(mRow + 2, "A").Value, "支", "")
ws2.Cells(mRow2 + 2, "A").Value = Replace(ws1.Cells(mRow + 3, "A").Value, "部", "")
ws2.Cells(mRow2 + 3, "A").Value = ws1.Cells(mRow + 4, "A").Value
ws2.Cells(mRow2 + 4, "A").Value = ws1.Cells(mRow + 5, "A").Value
mRow2 = mRow2 + 5
Else
'奇数の処理 偶数と同じように
End If
End If
Next
Set ws1 = Nothing
Set ws2 = Nothing
End Sub

回答No.1

kon555

勉強も兼ねて、という事なのでやや丁寧に行きますが、プログラムを組むにあたり「上手く出来ません。」はやめましょう。
　複数ある処理のどの部分がどう想定と違うのか？　「上手く出来ない」とは入力されるセルが違うのか、コピーする元が違うのか、エラーになってしまうのか。
　これら全て「上手く出来ない」のバリエーションですが、異なる原因で発生する別々の不良です。
　まずは起きている現象の詳細をしっかり認識し、プログラムのどの部分が原因なのか突き止める必要があります。それが出来るのは貴方だけですし、そうしなければスキルは磨けません。
　逆にステップ動作などで細かくデバッグし、想定通りに動くように修正していけば、自然とスキルが磨かれます。
https://www.excelspeedup.com/vbadebug/
https://excel-ubara.com/excelvba1/EXCELVBA490.html

　ちなみに「開始セルに〜これをキーにして繰り返し処理が出来ないか？」との事ですが、処理としては十分可能です。
　例えば下記の繰り返し処理は空白セルまで繰り返す、という作りになっていますが、少しアレンジすれば特定の値のセルまで、という改造は簡単です。
https://vbabeginner.net/loop-to-blank-cell/

　あるいはループ中にセルの値を取得し、条件に当てはまるかを調べて分岐させてもいいでしょう。
https://extan.jp/?p=9564
　やり方は色々あります。