表の整形

↓ このようなクイズがあったので、挑戦してみた。
上の表のコードについて、「/」で区切られたものを、
各々別の列に転記するというもの。
f:id:Infoment:20200424223944p:plain

恐らく世界中のオフィスで、似たような問題に悩んでい方々が居るに違いない。
f:id:Infoment:20200424224251j:plain

今回の作戦は、こんな感じだ。

  1. 新たな表のためのコレクションを準備。
  2. 各行のコードを、「/」で分割。
  3. 分割できなければ、そのままコレクションに追加。
    分割できたなら、分割結果の内訳毎でコレクションに追加。
  4. 元の表を一旦削除ののち、コレクションの中身をセット。
  5. 書式を整える。
Sub Hoge()
    
    ' 対象となるテーブル(表)。
    Dim Tb As Excel.ListObject
    Set Tb = ActiveSheet.ListObjects(1)
    
    ' 表のデータを格納するためのコレクション。
    Dim col As VBA.Collection
    Set col = New VBA.Collection
    
    ' 表を行単位で繰り返し処理。
    Dim ListRow As Excel.ListRow
        For Each ListRow In Tb.ListRows
            With ListRow.Range
                Dim arr As Variant
                    ' コードを「/」で分解。
                    ' 分解できたかどうかで処理分岐。
                    arr = Split(.Cells(1), "/")
                    If UBound(arr) = 0 Then
                    ' コレクションに各コードのレコードを格納。
                    ' 以下も同様。
                        col.Add Array(.Cells(1).Value, .Cells(2).Value, .Cells(3).Value)
                    Else
                        Dim i As Long
                            For i = 0 To UBound(arr)
                                col.Add Array(arr(i), .Cells(2).Value, .Cells(3).Value)
                            Next
                    End If
            End With
        Next
        
        ' テーブルの内容を一旦クリア。
        Tb.DataBodyRange.Delete
        
        ' コレクションのアイテムの数だけ、表に行を追加してセット。
        For i = 1 To col.Count
            With Tb.ListRows.Add
                .Range.Cells(1).Resize(, 3) = col.Item(i)
            End With
        Next
        
        ' コードの書式設定。
        With Tb.ListColumns("コード").DataBodyRange
            .NumberFormatLocal = "00000000"
            .HorizontalAlignment = xlLeft
        End With
        
End Sub

確認結果がこちら。
f:id:Infoment:20200424225037g:plain

これはこれで上手く行ったが、もとの表が3列と決め打ちしているのが難点かな。

参考まで。