| |
先週Excel4.0マクロの件でお世話になった者です。
中身は見れたもののコードの作りが今と違うのでさっぱり意味がわからず
結局自作しようということになったのですが行き詰まってしまったので
何かいい方法がないかと質問させてもらうことにしました。
一覧表から家系図のような表に変換するマクロを
作っているのですが、あまりにもコードが長くなるばかりで拡張性もなく
整理したいのですが何かいい方法はないでしょうか。
今作っているのは
1 A
2 B
1 C
2 D
3 E
2 F
みたいに1〜3に当てはめられたデータを下のように
1 2 3
A B
C D E
F
と列ごとに並び替えるマクロなんですが、
自分が作ったコードだとこれに4列目、5列目と増えることになると
肥大するばかりでなにがなんだかわからない状況になってしまいます。
これをもっとすっきり何列増えても対応するようなコードに整理したい
のですが何かいい方法はないでしょうか？？
説明がうまくできてないと思うのでここまで作ったコードを乗せておきます。
1〜3までならこのコードでうまくいきます。
A列に1〜3の数字を入れると機能します。
Dim i As Integer, u As Integer
i = 2
u = 8
Do While Cells(i, 1).Value <> ""
If Cells(i, 1).Value - Cells(i - 1, 1).Value = 0 Then
If Cells(i, 1).Value = 1 Then
Range(Cells(u + 1, 4), Cells(u + 6, 4)).Borders(xlEdgeBottom).LineStyle = xlContinuous
Range(Cells(u + 1, 4), Cells(u + 6, 4)).Borders(xlEdgeLeft).LineStyle = xlContinuous
Range(Cells(u + 6, 5), Cells(u + 10, 5)).BorderAround LineStyle:=xlContinuous
Cells(u + 6, 5).Value = Cells(i, 1).Value
ElseIf Cells(i, 1).Value = 2 Then
Range(Cells(u + 1, 4), Cells(u + 6, 4)).Borders(xlEdgeLeft).LineStyle = xlContinuous
Range(Cells(u + 1, 7), Cells(u + 6, 7)).Borders(xlEdgeBottom).LineStyle = xlContinuous
Range(Cells(u + 1, 7), Cells(u + 6, 7)).Borders(xlEdgeLeft).LineStyle = xlContinuous
Range(Cells(u + 6, 8), Cells(u + 10, 8)).BorderAround LineStyle:=xlContinuous
Cells(u + 6, 8).Value = Cells(i, 1).Value
ElseIf Cells(i, 1).Value = 3 Then
Range(Cells(u + 1, 4), Cells(u + 6, 4)).Borders(xlEdgeLeft).LineStyle = xlContinuous
Range(Cells(u + 1, 7), Cells(u + 6, 7)).Borders(xlEdgeLeft).LineStyle = xlContinuous
Range(Cells(u + 1, 10), Cells(u + 6, 10)).Borders(xlEdgeBottom).LineStyle = xlContinuous
Range(Cells(u + 1, 10), Cells(u + 6, 10)).Borders(xlEdgeLeft).LineStyle = xlContinuous
Range(Cells(u + 6, 11), Cells(u + 10, 11)).BorderAround LineStyle:=xlContinuous
Cells(u + 6, 11).Value = Cells(i, 1).Value
End If
u = u + 6
ElseIf Cells(i, 1).Value - Cells(i - 1, 1).Value = 1 Then
If Cells(i, 1).Value = 2 Then
Range(Cells(u, 6), Cells(u, 7)).Borders(xlEdgeBottom).LineStyle = xlContinuous
Range(Cells(u, 8), Cells(u + 4, 8)).BorderAround LineStyle:=xlContinuous
Cells(u, 8).Value = Cells(i, 1).Value
ElseIf Cells(i, 1).Value = 3 Then
Range(Cells(u, 9), Cells(u, 10)).Borders(xlEdgeBottom).LineStyle = xlContinuous
Range(Cells(u, 11), Cells(u + 4, 11)).BorderAround LineStyle:=xlContinuous
Cells(u, 11).Value = Cells(i, 1).Value
End If
ElseIf Cells(i, 1).Value - Cells(i - 1, 1).Value = -1 Then
If Cells(i, 1).Value = 1 Then
Range(Cells(u + 1, 4), Cells(u + 6, 4)).Borders(xlEdgeBottom).LineStyle = xlContinuous
Range(Cells(u + 1, 4), Cells(u + 6, 4)).Borders(xlEdgeLeft).LineStyle = xlContinuous
Range(Cells(u + 6, 5), Cells(u + 10, 5)).BorderAround LineStyle:=xlContinuous
Cells(u + 6, 5).Value = Cells(i, 1).Value
ElseIf Cells(i, 1).Value = 2 Then
Range(Cells(u + 1, 4), Cells(u + 6, 4)).Borders(xlEdgeLeft).LineStyle = xlContinuous
Range(Cells(u + 1, 7), Cells(u + 6, 7)).Borders(xlEdgeBottom).LineStyle = xlContinuous
Range(Cells(u + 1, 7), Cells(u + 6, 7)).Borders(xlEdgeLeft).LineStyle = xlContinuous
Range(Cells(u + 6, 8), Cells(u + 10, 8)).BorderAround LineStyle:=xlContinuous
Cells(u + 6, 8).Value = Cells(i, 1).Value
End If
u = u + 6
ElseIf Cells(i, 1).Value - Cells(i - 1, 1).Value = -2 Then
If Cells(u, 8).Value = "" Then
Range(Cells(u + 1, 6), Cells(u + 1, 7)).AutoFill Destination:=Range(Cells(u - 5, 6), Cells(u + 1, 7)), Type:=xlFillDefault
End If
Range(Cells(u + 1, 4), Cells(u + 6, 4)).Borders(xlEdgeBottom).LineStyle = xlContinuous
Range(Cells(u + 1, 4), Cells(u + 6, 4)).Borders(xlEdgeLeft).LineStyle = xlContinuous
Range(Cells(u + 6, 5), Cells(u + 10, 5)).BorderAround LineStyle:=xlContinuous
Cells(u + 6, 5).Value = Cells(i, 1).Value
u = u + 6
End If
i = i + 1
Loop
ActiveCell.Offset(1, 0).Select
|
|
たろう
- 13/1/17(木) 11:45 -
