【VBA】このCSV作成におけるループ処理の仕方が分からない

Question

質問

下記のエクセルデータを

番号	内容1	内容2	内容3	補足	注意事項
1	1a.jpg	1b.jpg	1c.jpg	あああ	かかか
2	2a.jpg	2b.jpg	2cjpg	いいい	ききき
3	3a.jpg	3b.jpg	3c.jpg	ううう	くくく

このようなcsvとして出力したい

番号	順番	内容	補足	注意事項
1	1	1a.jpg	あああ	かかか
1	2	1b.jpg
1	3	1c.jpg
2	1	2a.jpg	いいい	ききき
2	2	2b.jpg
2	3	2c.jpg
3	1	3a.jpg	ううう	くくく
3	2	3b.jpg
3	3	3c.jpg

考えた事

For~Next文で出来るか考えたが難しそうなので
Do Loop文ならできそうだけど思いつかない

お願いします。

Comments

[y_waiwai]

で、しつもんはなんでしょうか

[pig_vba]

>For~Next文で出来るか考えたが難しそうなので
for nextが一番簡単に実装できそうですが…
今のままだと完全に丸投げになるので「どこまでなら書けるか」を質問文に追記していただければ比較的回答が付きやすくなると思います
例：1行だけなら仕様通りの並びに変えられる、csv出力は書ける等

Answer 1

どうもfor nextとifを使った文が好きになれなかったのと長いので
Do Loopで書いてみました。

Sub test()

   Dim sht As Worksheet
   Dim exp As Worksheet
   Dim i As Long
   Dim j As Long
   
   Set sht = Worksheets("sheet2")
   Set exp = Worksheets("sheet3")
   i = 2
   j = 2
   
   Do Until sht.Cells(j, 1).Value = ""
            exp.Cells(i, 1) = sht.Cells(j, 1)
            exp.Cells(i + 1, 1) = sht.Cells(j, 1)
            exp.Cells(i + 2, 1) = sht.Cells(j, 1)
            
            exp.Cells(i, 2) = 1
            exp.Cells(i + 1, 2) = 2
            exp.Cells(i + 2, 2) = 3
            
            exp.Cells(i, 3) = sht.Cells(j, 2)
            exp.Cells(i + 1, 3) = sht.Cells(j, 3)
            exp.Cells(i + 2, 3) = sht.Cells(j, 4)
            
            exp.Cells(i, 4) = sht.Cells(j, 5)
            exp.Cells(i, 5) = sht.Cells(j, 6)
            
            i = i + 3
            j = j + 1
   Loop

End Sub

Answer 2

なるほど！
if構文で判定してやっていく方法なんですね！

Answer 3

こんな感じで実装できます。
コードそのまま渡したらただの作業依頼なので一部はヒントを参考に自分で埋めてください。

Option Explicit
Option Base 1

Sub てすと()
    
    Dim rng As Range
    Dim r As Long
    Dim c As Long
    Dim entRow As Long
    
    '元シート
    Dim form As Worksheet: Set form = ThisWorkbook.ActiveSheet
    
    'csv出力用
    Dim csv As Workbook
    Set csv = Workbooks.Add
    Dim wsCSV As Worksheet
    Set wsCSV = csv.Sheets(1)
    
    
    wsCSV.Range("A1:E1").Value = Array("番号", "順番", "内容", "補足", "注意事項")
    For r = 2 To 4
        '初期位置設定
        Set rng = wsCSV.Cells(Rows.Count, 3).End(xlUp).Offset(1, 0)
        
        For c = 2 To 4
        With form
            If c = 2 Then .Range(.Cells(r, 4), .Cells(r, 5)).Copy Destination:=rng.Offset(0, 1)
            
            rng.Offset(0, -2).Value = 'ヒント：同じ行は同じ数値
            rng.Offset(0, -1).Value = 'ヒント：同じ行の何番目か？答えはコード内に
            rng.Value = 'ここはさすがにわかりますよね
        End With
            Set rng = rng.Offset(1, 0)
        Next c
    Next r
    
    'csvとして保存する処理（自分で実装してね）
    
End Sub