|
こんにちは。かみちゃん です。
>に自動的に変換するVBAコードを教えて頂きたいのですが、よろしくお願いします。ただし、行と列の数は任意とします。要は最終列にあるカンマ区切りのデータを分離して最終列 +(データ数 - 1)列の罫線付き表に書き直し、最終列のタイトル(第1行目)のセルは最大データ数(上記の例では3)に応じたセルの大きさにしたい。
・セルA1から表が始まること
・表の途中には、1行がすべて空白の行、1列がすべて空白の列がないこと
以上を前提にすると、以下のマクロでできると思います。(動作確認済み)
多少、マクロの記録そのままのコードを載せていますので、長くなっています。
長ければ※印の行は削除していただいてもいいです。
ポイントは、変形前の最終列を取得と、その列全体を「データ」の「区切り位置」でカンマで区切っているところです。
Option Explicit
Sub Macro1()
Dim MaxColumn As Integer, MaxColumnStart As Integer
'変形前の最終列を取得
'表の途中に空白行、空白列がないことが前提
MaxColumn = Range("A1").CurrentRegion.Columns.Count
MaxColumnStart = MaxColumn
'最終列をカンマ区切りで分割
Columns(MaxColumn).Select
Selection.TextToColumns Destination:=Cells(1, MaxColumn), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
Semicolon:=False, Comma:=True, Space:=False, Other:=False, FieldInfo _
:=Array(1, 1), TrailingMinusNumbers:=True
'変形後の表の大きさを取得
MaxColumn = Range("A1").CurrentRegion.Columns.Count
'変形後の表全体の罫線処理(マクロの記録により記述)
Range("A1").CurrentRegion.Select
Selection.Borders(xlDiagonalDown).LineStyle = xlNone '※
Selection.Borders(xlDiagonalUp).LineStyle = xlNone '※
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.Weight = xlThin '※
.ColorIndex = xlAutomatic '※
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.Weight = xlThin '※
.ColorIndex = xlAutomatic '※
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlThin '※
.ColorIndex = xlAutomatic '※
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.Weight = xlThin '※
.ColorIndex = xlAutomatic '※
End With
With Selection.Borders(xlInsideVertical)
.LineStyle = xlContinuous
.Weight = xlThin '※
.ColorIndex = xlAutomatic '※
End With
With Selection.Borders(xlInsideHorizontal)
.LineStyle = xlContinuous
.Weight = xlThin '※
.ColorIndex = xlAutomatic '※
End With
'拡張したタイトル行の修正
Range(Cells(1, MaxColumnStart), Cells(1, MaxColumn)).Select
' Range("C1:E1").Select
Selection.Borders(xlDiagonalDown).LineStyle = xlNone '※
Selection.Borders(xlDiagonalUp).LineStyle = xlNone '※
With Selection.Borders(xlEdgeLeft) '※
.LineStyle = xlContinuous '※
.Weight = xlThin '※
.ColorIndex = xlAutomatic '※
End With '※
With Selection.Borders(xlEdgeTop) '※
.LineStyle = xlContinuous '※
.Weight = xlThin '※
.ColorIndex = xlAutomatic '※
End With '※
With Selection.Borders(xlEdgeBottom) '※
.LineStyle = xlContinuous '※
.Weight = xlThin '※
.ColorIndex = xlAutomatic '※
End With '※
With Selection.Borders(xlEdgeRight) '※
.LineStyle = xlContinuous '※
.Weight = xlThin '※
.ColorIndex = xlAutomatic '※
End With '※
Selection.Borders(xlInsideVertical).LineStyle = xlNone
'拡張したタイトルをセル結合する
Selection.MergeCells = True
Range("A1").Select
End Sub
|
|