データの加工をして別シートに移したい

Question

##前提
ところどころ「"」「,」だったり余分なものが入っています。
例で5行まで書いたのですが、何行か分かりません。
c列は必要な番号があったり、いらない空白があったりしています。

###実現したいこと
①のデータを③に加工して別シートにコピーしたいです。

B列をコピーC列に番号がない場合、E列の最初の番号とF列の最初の番号をコピーして1行
C列に番号があれば、C列とD列をコピーして1行

E列にカンマ区切りの番号が複数ある場合
B列コピーE列の1番目の番号をコピー、F列の1番目の番号をコピーして1行
B列コピーE列の2番目の番号をコピー、F列の2番目の番号をコピーして1行
説明が下手ですが、図を見たほうが早いですかね。。。

上記を繰り返すと②のようなデータができると思うのですが、
その②のデータで番号の重複箇所があれば削除して最終的には③にして別シートにコピーしたいです。
→裏で③のような形にしてから別シートにコピーしたいです。
お手数ですが、わかる方教えて頂けないでしょうか。

①データ
A B 　　　　C D E F
1 91232310 '12145, 　　　 　 リンゴ
2 92311232 , '12124,12124, パイナップル,パイナップル
3 93232535 12359, オレンジ '12124, 　　　　 　バナナ
4 95345626 , '12445,12329, ブドウ,キュウイ
5 95233250 ,, '14393,12325,14393, スイカ,バナナ,スイカ

②
1 91232310 12124 リンゴ
2 92311232 12124 パイナップル
3 92311232 12124 パイナップル
4 93232535 12359 オレンジ
5 93232535 12124 バナナ
6 95345626 12445 ブドウ
7 95345626 12329 キュウイ
8 95233250 14393 スイカ
9 95233250 12325 バナナ
10 95233250 14393 スイカ

③データを加工して以下のようにしたい
1 91232310 12124 リンゴ
2 92311232 12124 パイナップル
3 93232535 12359 オレンジ
4 93232535 12124 バナナ
5 95345626 12445 ブドウ
6 95345626 12329 キュウイ
7 95233250 14393 スイカ
8 95233250 12325 バナナ

Answer 1

地道に1行ずつ下記の処理を当てていく形になりそうです。

ところどころ「"」「,」だったり余分なものが入っています。

例で5行まで書いたのですが、何行か分かりません。
c列は必要な番号があったり、いらない空白があったりしています。

Replaceで不要なデータを指定して削除。
複数回使うと思うのでReplaceだけ回す自作関数を作っておけば今後も流用出来ます。

B列をコピーC列に番号がない場合、E列の最初の番号とF列の最初の番号をコピーして1行

C列に番号があれば、C列とD列をコピーして1行

if文でC列の文字列の長さが0（""）か判別して分岐。

E列にカンマ区切りの番号が複数ある場合

inStr関数なら先頭の指定文字位置を検索できるのでLeft関数でコピー。
残りの文字列をMid関数（末尾はLen関数で取得）で取得して文字列の長さをif文で判定して分岐。
Trueなら再度inStr関数を使い抜き出す。

②のデータで番号の重複箇所があれば削除して最終的には③にして別シートにコピーしたいです。

→裏で③のような形にしてから別シートにコピーしたいです。

ソートして上下比較したりなど方法は色々ありますが下記の記事が一番近いのでは？
重複削除してコピー（AdvancedFilter）

Answer 2

Sub sample()
    
    Dim ①, ②, ③, 行, A列, B列, C列, D列, E列, F列, データ, キー, 連番, i
    
    Set ① = Worksheets("元シート")
    Set ② = CreateObject("Scripting.Dictionary")
    Set ③ = Worksheets("結果シート")
    
    '①シートの使用されている範囲を１行ごとに処理
    For Each 行 In ①.UsedRange.Rows
        
        '各列の値を取得
        A列 = 行.Columns("A")
        B列 = 行.Columns("B")
        C列 = 行.Columns("C")
        D列 = 行.Columns("D")
        E列 = 行.Columns("E")
        F列 = 行.Columns("F")
        
        '余分なものを除去
        C列 = Replace(C列, ",", "")
        E列 = Replace(E列, "'", "")
        
        'カンマで分割
        E列 = Split(E列, ",")
        F列 = Split(F列, ",")
        
        'C列が番号だったらB列, C列, D列を②に入れる（重複した場合は入れない）
        If IsNumeric(C列) Then
            データ = Array(B列, C列, D列)
            キー = Join(データ, vbTab)
            If Not ②.Exists(キー) Then ②.Add キー, データ
        
        End If
            
        'E列が番号だったらB列, E列, F列を②に入れる（重複した場合は入れない）
        For i = 0 To UBound(E列)
            If IsNumeric(E列(i)) Then
                データ = Array(B列, E列(i), F列(i))
                キー = Join(データ, vbTab)
                If Not ②.Exists(キー) Then ②.Add キー, データ
            End If
        Next
        DoEvents
    Next
    
    '②から取り出して③シートに出力
    For Each データ In ②.Items
        連番 = 連番 + 1
        ③.Cells(連番, "A") = 連番
        ③.Cells(連番, "B") = データ(0)
        ③.Cells(連番, "C") = データ(1)
        ③.Cells(連番, "D") = データ(2)
    Next
    
    
End Sub

Comments

[LifeGrow]

ありがとうございます。勉強になりました。