表の整形
↓ このようなクイズがあったので、挑戦してみた。
上の表のコードについて、「/」で区切られたものを、
各々別の列に転記するというもの。
恐らく世界中のオフィスで、似たような問題に悩んでい方々が居るに違いない。
今回の作戦は、こんな感じだ。
- 新たな表のためのコレクションを準備。
- 各行のコードを、「/」で分割。
- 分割できなければ、そのままコレクションに追加。
分割できたなら、分割結果の内訳毎でコレクションに追加。 - 元の表を一旦削除ののち、コレクションの中身をセット。
- 書式を整える。
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
確認結果がこちら。
これはこれで上手く行ったが、もとの表が3列と決め打ちしているのが難点かな。
参考まで。