| |
こんにちは。かみちゃん です。
>に自動的に変換するVBAコードを教えて頂きたいのですが、よろしくお願いします。ただし、行と列の数は任意とします。要は最終列にあるカンマ区切りのデータを分離して最終列 ＋（データ数 - 1）列の罫線付き表に書き直し、最終列のタイトル（第１行目）のセルは最大データ数（上記の例では３）に応じたセルの大きさにしたい。
・セルA1から表が始まること
・表の途中には、１行がすべて空白の行、１列がすべて空白の列がないこと
以上を前提にすると、以下のマクロでできると思います。（動作確認済み）
多少、マクロの記録そのままのコードを載せていますので、長くなっています。
長ければ※印の行は削除していただいてもいいです。
ポイントは、変形前の最終列を取得と、その列全体を「データ」の「区切り位置」でカンマで区切っているところです。
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
|
|
![[未読]](./data/excel/image/read_icon.gif){kind=icon}
- 04/9/2(木) 3:04 -
