VBAで必要データ(セル)を取得

Question

前提・実現したいこと

まず最終的にやりたいことですが
複数Sheetに渡ってある同形式の表から必要箇所(セルデータ)をもってきて
それを1つのSheetに縦方向に結合した表を作成することです。

▼イメージ図

上で説明した必要データを持ってきて縦に結合という処理は
既にできているのですが、その処理の中で想定通りに動かない
（処理を書いてないので当たり前ですが）
部分があるのでそこの記述の仕方を教えて頂きたく思います。

---

以下の2つの画像(1枚目が処理前、2枚目が処理後)を使って説明します。

尚、色付きセルは必要データでbefore1それぞれの色はafterに対応しています。

▼処理前Sheet(複数あるうちの1Sheet(before1))

▼処理後Sheet(after)

---

ここで、処理前Sheetの26、27行目と処理後Sheetの9、10行目を見て頂きたいのですが
個々の部品は親部品2つに対して子部品が2つあります。
しかし画像だと、子部品が次の列に移らず同じデータを取ってきています。
これを子部品と同じ数だけ親部品も下にコピーしたいのです。

これまた分かりにくい説明だと思うので画像も確認お願いします。

---

説明が下手すぎて伝わっていない部分もあるはずなので
補足をしながら解決できたらと思います。
ご協力よろしくお願いします。

該当のソースコード

      
Sub シート別データ結合テスト()

Dim sht0 As Worksheet, sht1 As Worksheet
Dim i As Long
Dim j As Long
Dim Frm As Long
Dim C_Column As String
Dim D_Column As Long
Dim N_Column As String
Dim P_Column As String
Dim Q_Column As String
Dim S_Column As Double

j = 5

''''''''''''''''''    メイン処理    ''''''''''''''''''

Set sht1 = Sheets("after")
    
    For Each sht0 In ThisWorkbook.Sheets
        
        If sht0.Name <> sht1.Name Then
             For i = 8 To 60 Step 2
                If (sht0.Cells(i, 14).Value) = "" Then
                    '何もしない
                Else
                    If sht0.Cells(i, 3).Value = "" Then
                        '何もしない
                    Else
                        C_Column = sht0.Cells(i, 3).Value
                        D_Column = sht0.Cells(i, 4).Value
                        N_Column = sht0.Cells(i, 14).Value
                        P_Column = sht0.Cells(i, 16).Value
                        Q_Column = sht0.Cells(i, 17).Value
                        S_Column = sht0.Cells(i + 1, 19).Value
                    End If
                        sht1.Cells(j, 1) = C_Column
                        sht1.Cells(j, 2) = D_Column
                        sht1.Cells(j, 3) = N_Column
                        sht1.Cells(j, 4) = P_Column
                        sht1.Cells(j, 5) = Q_Column
                        sht1.Cells(j, 6) = S_Column
                        sht1.Cells(j, 7) = sht0.Name
                        sht1.Cells(j, 8) = i
                        j = j + 1
                End If
            Next
        End If
    Next sht0
    
'''''''''''''''''' フォーマット設定 ''''''''''''''''''

    For Frm = 1 To 1000
    
        With Cells(Frm, 2)
            .NumberFormatLocal = "@"
            .Value = Format(.Value, "000")
        End With
        
        With Cells(Frm, 4)
            .NumberFormatLocal = "@"
            .Value = Format(.Value, "000")
        End With
        
        With Cells(Frm, 6)
            .NumberFormatLocal = "@"
            .Value = Format(.Value, "##0.0000")
        End With
        
    Next Frm
End Sub

---

すみません。もう少し簡潔に書かせていただきます。

以下のような表があったとして

ソースでは、まずN列のセルが空文字でないか判定し
空文字でないつまりデータがあれば次の処理に移り
C列が空文字かどうかを判定しています。
そして、それもFalseなら初めて処理が実行されるようになっています。

今回やりたいのは、この処理に加えて
上の表のC列が空文字なら空白行分、一番最初の空文字セルの2つ上の値と
同じものを空文字でなくなるまで値を移し、子部品はこの表であれば
4部品分データを取得して値を移したいと思っています。

この画像が処理後実現したい表になります。

Answer 1

Ｃ列が空白の時、D列の情報もN列の情報もP列の情報も無視しているからです。

If sht0.Cells(i, 3).Value = "" Then
    '何もしない
Else
    C_Column = sht0.Cells(i, 3).Value
    D_Column = sht0.Cells(i, 4).Value
    N_Column = sht0.Cells(i, 14).Value
    P_Column = sht0.Cells(i, 16).Value
    Q_Column = sht0.Cells(i, 17).Value
    S_Column = sht0.Cells(i + 1, 19).Value
End If

これではＣ列が空白の時は、D_Columnなども更新されない為
一つ前の情報をそのまま書くことになります。

考え方は色々ありますがベタ打ちするなら、

If sht0.Cells(i, 3).Value <> "" Then
    C_Column = sht0.Cells(i, 3).Value
End If
If sht0.Cells(i, 4).Value <> "" Then
    D_Column = sht0.Cells(i, 4).Value
End If
If sht0.Cells(i, 14).Value <> "" Then
    N_Column = sht0.Cells(i, 14).Value
End If
'以下同様

これでその項目が空白の時は
一つ前の情報を書くようになります。

Comments

[kitten]

ありがとうございます！
無事解決いたしました！

Answer 2

最後の画像をみる限りだと、パターンがしっかり決まっているから、まだ楽だと思います。
ひとまず2つの構造体作って、試すのが良いと思います。
サンプルですが下記のような感じで組めば良いと思います。

Type ColumnAB
   ColumnA As String
   ColumnB As String
End Type

Type ColumnDFGI
    ColumnD As String
    ColumnF As String
    ColumnG As String
    ColumnI As String
End Type

//少し省略
For rawCount To rawMax Step 2
    CA = sht0.Cells(rawCount, 1).Value
    CB = sht0.Cells(rawCount, 1).Value
    if //CAとCBが空白でない場合 Then
        columnAB.ColumnA = CA
        columnAB.ColumnB = CB
    Endif

    ColumnDFGI.ColumnD = sht0.Cells(rawCount, 4).Value
    ColumnDFGI.ColumnF = sht0.Cells(rawCount, 14).Value
    ColumnDFGI.ColumnG = sht0.Cells(rawCount, 16).Value
    ColumnDFGI.ColumnI = sht0.Cells(rawCount + 1, 17).Value
    
    //あとはA,B,D,F,G,Iのセルに渡すだけなので省略
Next rawCount