【Excel VBA】行×列1,列2,列3,列4の組み合わせで列挙する方法

行×列の組み合わせで値を列挙する方法は以前解決したのですが、
また難問にぶつかりました。
添付画像のような表を同様に列挙したいのですが、行×列1,列2,列3,列4みたいな組み合わせで書き出したいのです

※見やすくするために空行を入れてますが実際には詰めてます。
　固定値の個所は"固定値"としてすべて同じ文字を入れたいだけです。下記の横方向には違うテキスト。縦方向には同一テキストです。

固定値,A1,固定値,固定値,固定値,B1項目名,B1,B2,B3,B4
固定値,A1,固定値,固定値,固定値,C1項目名,C1,C2,C3,C4
固定値,A1,固定値,固定値,固定値,D1項目名,D1,D2,D3,D4
固定値,A1,固定値,固定値,固定値,E1項目名,E1,E2,E3,E4
固定値,A1,固定値,固定値,固定値,F1項目名,F1,F2,F3,F4
固定値,A1,固定値,固定値,固定値,G1項目名,G1,G2,G3,G4
固定値,A1,固定値,固定値,固定値,H1項目名,H1,H2,H3,H4
固定値,A1,固定値,固定値,固定値,I1項目名,I1,I2,I3,I4
固定値,A1,固定値,固定値,固定値,J1項目名,J1,J2,J3,J4
固定値,A1,固定値,固定値,固定値,K1項目名,K1,K2,J4,K4
固定値,A1,固定値,固定値,固定値,L1項目名,L1,L2,L4,L4

固定値,A2,固定値,固定値,固定値,B1項目名,B1,B2,B3,B4
固定値,A2,固定値,固定値,固定値,C1項目名,C1,C2,C3,C4
固定値,A2,固定値,固定値,固定値,D1項目名,D1,D2,D3,D4
固定値,A2,固定値,固定値,固定値,E1項目名,E1,E2,E3,E4
固定値,A2,固定値,固定値,固定値,F1項目名,F1,F2,F3,F4
固定値,A2,固定値,固定値,固定値,G1項目名,G1,G2,G3,G4
固定値,A2,固定値,固定値,固定値,H1項目名,H1,H2,H3,H4
固定値,A2,固定値,固定値,固定値,I1項目名,I1,I2,I3,I4
固定値,A2,固定値,固定値,固定値,J1項目名,J1,J2,J3,J4
固定値,A2,固定値,固定値,固定値,K1項目名,K1,K2,K3,K4
固定値,A2,固定値,固定値,固定値,L1項目名,L1,L2,L3,L4
・
・
・
A24まで、またはA**の値が例えば「最終行」の行が最終行となります。

この様な場合、どんな処理の繰り返しになるんでしょう？

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

• 

  添付画像を細かく見ると誤解される箇所がありましたが、
  画像も小さくて見づらいので、テキストで訂正します。
  
  列の項目名は、
  1行につきB～L、B～L、B～L、B～Lと4回出てきます。
  こんな繰り返しの並び替えです。
  
  A1,B1,B1,B2,B3,B4
  ～
  A1,L1,L1,L2,L4,L4
  
  A2,B1,B1,B2,B3,B4
  ～
  A2,L1,L1,L2,L3,L4
  
  ～
  
  A24,B1,B1,B2,B3,B4
  ～
  A24,L1,L1,L2,L3,L4
  
  分かりづらくてすみません。おかしい点があれば補足します。

    補足日時：2021/07/09 18:32

• 

  失礼しました。
  以前解決したという方法はこちらです。
  https://oshiete.goo.ne.jp/qa/12431789.html
  
  行×列がシンプルになるパターンでした。

    補足日時：2021/07/09 20:15

• 端までキャプチャーすると画像が縮小されて見づらくなるので、
  値グループ2まで見せてます。
  値グループ1～値グループ4まであります。
  1行目は最初はBの黄色部分を並べて
  2行目は、C部分を並べて、
  D～Lまでの繰り返しです。
  次1行下がって、A2から始まる、の繰り返しです。
  説明分かりづらくてすみません。

  
  No.3の回答に寄せられた補足コメントです。 補足日時：2021/07/09 21:57

No.8 ベストアンサー 回答者： tatsumaru77 回答日時： 2021/07/13 16:53

No6です。

以下のようにしてください。

Public Sub 列挙()
Dim sh1 As Worksheet
Dim sh2 As Worksheet
Dim row1 As Long
Dim row2 As Long
Dim col1 As Long
Dim maxrow As Long
Dim grp_no As Long 'グループ番号（1～4）
Dim seq_no As Long 'B列～L列の番号（1～11）
Set sh1 = Worksheets("Sheet1")
Set sh2 = Worksheets("Sheet2")
maxrow = sh1.Cells(Rows.Count, "A").End(xlUp).Row 'sheetの最大行取得
'4行目以降をクリア
sh2.Rows("4:" & Rows.Count).Clear
row2 = 4
For row1 = 4 To maxrow
For seq_no = 1 To 11
sh2.Cells(row2, 1).Value = "固定値1"
sh2.Cells(row2, 2).Value = sh1.Cells(row1, "A").Value
sh2.Cells(row2, 3).Value = "固定値2"
sh2.Cells(row2, 4).Value = "固定値3"
sh2.Cells(row2, 5).Value = "固定値4"
sh2.Cells(row2, 6).Value = sh1.Cells(3, 5 + seq_no).Value
sh2.Cells(row2, 7).Value = sh1.Cells(row1, 5 + 0 * 11 + seq_no).Value
sh2.Cells(row2, 8).Value = "固定値5"
sh2.Cells(row2, 9).Value = sh1.Cells(row1, 5 + 1 * 11 + seq_no).Value
sh2.Cells(row2, 10).Value = "固定値6"
sh2.Cells(row2, 11).Value = sh1.Cells(row1, 5 + 2 * 11 + seq_no).Value
sh2.Cells(row2, 12).Value = sh1.Cells(row1, 5 + 3 * 11 + seq_no).Value
row2 = row2 + 1
Next
Next
End Sub

この回答へのお礼

すごいです。期待通りに変更されました。
つまりFor文で一気に出力してたのを止めて、
1行ずつ書き出しに変更したという事でしょうか？
列番号を出すための数式が理解できませんでした(涙
「*11」してる理由とか。。。
自分で書けるようになりたいのですが、、
ありがとうございました！

お礼日時：2021/07/13 18:18

No.12 回答者： めぐみん_ 回答日時： 2021/07/15 18:37

こんな感じでしょうか？

Sub megu()
Dim r1 As Range
Dim r As Range, rr, rs
Dim r2 As Range, v, vv, i As Long

Application.ScreenUpdating = False

Set r2 = Worksheets("Sheet2").Range("A4") ' 書き出すシートと開始セル番地

r2.Parent.Range(r2, r2.Parent.Cells(Rows.CountLarge, Columns.CountLarge)).ClearContents

v = Array( _
"固定値", _
"A1", _
"固定値", _
"固定値", _
"固定値", _
"B1項目名", _
0, _
"固定値", _
0, _
"固定値", _
0, _
0 _
)

vv = Array(6, 8, 10, 11)
rs = Array("F1", "Q1", "AB1", "AM1")

With Worksheets("Sheet1")
Set r1 = .Range("A4", .Cells(Rows.CountLarge, "A").End(xlUp)) ' 元データのシートとセル範囲

For Each r In r1
r2.Resize(11, 12).Value = v
r2.Offset(, 1).Resize(11).Value = r.Value
.Cells(3, "F").Resize(, 11).Copy
r2.Offset(, 5).PasteSpecial Paste:=xlPasteValues, Transpose:=True

i = 0

For Each rr In rs

r.Range(rr).Resize(, 11).Copy
r2.Offset(, vv(i)).PasteSpecial Paste:=xlPasteValues, Transpose:=True
Application.CutCopyMode = False

i = i + 1

Next

Set r2 = r2.Offset(11)
Next

End With

Application.ScreenUpdating = True

Set r1 = Nothing
Set r2 = Nothing

End Sub

No.11 回答者： めぐみん_ 回答日時： 2021/07/15 08:42

そう言えば質問文（データの書き出し）を改めてみて配列は不要な感じがしました。

と言うより１行ずつ書き出す意味はなく、まずＡ１に対して１１行書き出したいデータを範囲で代入させてしまい、変動する部分には仮に "" でも入れておく。
あとは項目・グループ毎に『行列入れ替え』で代入させたい所に放り込んでいけばＡ１の表は完成するのかなと。
あとは～Ａ最終行まで繰り返していけば良かったのかもですね。

ジジィなので『行列入れ替え』に気づくのが遅くなるなんてボケてますよね。

この回答へのお礼

丁寧な解説ありがとうございます！
色々な方法論からチョイスする必要があると思ってるので助かります。

お礼日時：2021/07/15 09:21

No.10 回答者： めぐみん_ 回答日時： 2021/07/14 11:09

No.9です。

コード作成中に別回答が付いたので削除しちゃいましたし。
質問が解決されたなら閉じるのがマナーかと。

この回答へのお礼

はい。
ありがとうございました！

お礼日時：2021/07/14 15:32

No.9 回答者： めぐみん_ 回答日時： 2021/07/13 18:41

No.7です。

補足もありませんでしたしベテラン様が解決されたようなので、配列による手法は必要なさそうですね。（まだ作ってませんし）

無事な解決おめでとうございます。

この回答へのお礼

せっかくアイデアを出して頂いたのに返事が追い付かず申し訳ありませんでした。
配列による手法というのも気になります。。。
ありがとうございました。

お礼日時：2021/07/14 11:06

No.7 回答者： めぐみん_ 回答日時： 2021/07/11 10:36

取り敢えず、

＞A24まで、またはA**の値が例えば「最終行」の行が最終行となります。

Ａ列の最後の値が『最終行』であった場合、その行は作業があるのですか？
それともＢ列以降はデータはないから１つ上の行で終わりなのでしょうか？
または『Ａ２１』まで記載があってＡ２１と書かれた行までなのでしょうか？

ベテラン様の回答も出てますしExcelないので気になった点だけで。
⇒マルチブートですが全てにOfficeを入れてないもので。

この回答へのお礼

完成を急いでおり、なかなかお返事できず申し訳ありません。
元の表には全ての列全ての行にデータが入っている想定ですので、
A列最終行の行に対しても作業があります。
ありがとうございました。

お礼日時：2021/07/14 11:05

No.6 回答者： tatsumaru77 回答日時： 2021/07/11 09:39

以下のマクロを標準モジュールに登録してください。

Sheet1が元データ、Sheet2が出力先のシート名になっています。
シート名はあなたの環境にあわせて適切に設定してください。

Option Explicit
Public Sub 列挙()
Dim sh1 As Worksheet
Dim sh2 As Worksheet
Dim row1 As Long
Dim row2 As Long
Dim col1 As Long
Dim maxrow As Long
Dim grp_no As Long 'グループ番号（1～4）
Dim seq_no As Long 'B列～L列の番号（1～11）
Set sh1 = Worksheets("Sheet1")
Set sh2 = Worksheets("Sheet2")
maxrow = sh1.Cells(Rows.Count, "A").End(xlUp).Row 'sheetの最大行取得
'4行目以降をクリア
sh2.Rows("4:" & Rows.Count).Clear
row2 = 4
For row1 = 4 To maxrow
For seq_no = 1 To 11
sh2.Cells(row2, 1).Value = "固定値1"
sh2.Cells(row2, 2).Value = sh1.Cells(row1, "A").Value
sh2.Cells(row2, 3).Value = "固定値2"
sh2.Cells(row2, 4).Value = "固定値3"
sh2.Cells(row2, 5).Value = "固定値4"
sh2.Cells(row2, 6).Value = sh1.Cells(3, 5 + seq_no).Value
For grp_no = 1 To 4
sh2.Cells(row2, 6 + grp_no).Value = sh1.Cells(row1, 5 + (grp_no - 1) * 11 + seq_no).Value
Next
row2 = row2 + 1
Next
Next
End Sub

この回答へのお礼

ありがとうございます。
意図通り完璧でした。(実際のフォーマットとサンプルのずれは、ソース内の値をカスタマイズして調整できました)

大変申し訳ないのですが、少し修正があり、
値1グループと値2グループの間に固定値1列、
値2グループと値3グループの間に固定値1列を挟むように変えられないでしょうか？

つまり、元の表現の仕方で表すとこのようになります。

固定値,A1,固定値,固定値,固定値,B1項目名,B1,B2,B3,B4
↓↓↓
固定値,A1,固定値,固定値,固定値,B1項目名,B1,固定値,B2,固定値,B3,B4

以下のソース部分を修正すれば良いとは思うのですが、うまくいきません。。。
For grp_no = 1 To 4
sh2.Cells(row2, 6 + grp_no).Value = sh1.Cells(row1, 5 + (grp_no - 1) * 11 + seq_no).Value

すみません、よろしくお願いいたします。

お礼日時：2021/07/13 15:18

No.5 回答者： めぐみん_ 回答日時： 2021/07/10 18:14

No.3の補足について。

なんか最初の質問文では『値グループ３』が少ない点の疑問が抜けなくなってしまいます。
ベテラン様も出てきてくれたようですしジジィは退散ですね。
どんなに回答しても所詮初級者はベテラン様の長いコードには勝てませんので。

この回答へのお礼

値グループ３が6列少ないのは私の画像のミスでした。
大変失礼いたしました。
規則性通りなのが正解です。

お礼日時：2021/07/11 08:41

No.4 回答者： tatsumaru77 回答日時： 2021/07/10 12:55

①添付の画像がよく見えないので、下記にアップしました。

下記であってますか。最後の列はAWになります。
あなたが提示した画像ではAQになっています。
どちらが正しいでしょうか。
https://gyazo.com/ddac14ed985cb8ff7525eebf06140bda


②上記内容をもとにした出力結果は下記URLであってますか。
４行目から出力しますが、よろしいでしょうか。
https://gyazo.com/086741f36aacb786b77fe6a7b1c28b75

この回答へのお礼

>①
ありがとうございます。
ご指摘の通りです。最初に私が載せた画像は、値グループ3が6列抜けてました。(B～Gが抜けてる)だからAQ列が最後になってます。
tatsumaru77さんのAWが最終列で正解です。
大変失礼いたしました。

>②
拝見しました。全くその通りです。
自分の力ではノーアイデアで、、、
大変負担のかかる事ではないかと恐縮してますが、
もし実現したらすごく嬉しいです。

お礼日時：2021/07/11 08:40

No.3 回答者： めぐみん_ 回答日時： 2021/07/09 20:38

でも画像とテキストの関係性が良くわかりません。

＞1行につきB～L、B～L、B～L、B～Lと4回出てきます。

これはどこを指していて何をどうすればいいのか画像との整合性を表した方が良いかなって感じますよ。
⇒画像ファイルで言うなら知恵袋の方が見やすいかもですけど。