各列にカラム名をつけるVBA
ExcelやCSVで受け取るデータは、1行目がタイトル行、2行目以降がデータという形式の割合が高いです。
また、こちらの記事で書いたように、Excelではセルの名前を使うと、分かりやすい式を書くことができます。
これらを考え合わせると、タイトルに示されているカラム名をデータの領域に勝手につけてくれるマクロがあると、仕事がはかどると思いませんか?
そこで、そのようなマクロを作ってみました。
'--------------------------------------------------------------------
' Summary: 各列の2行目から最終行までのレンジに1行目のカラム名を付ける
' Remarks: アクティブシートのシートの全列に作用する
'--------------------------------------------------------------------
Public Sub NameTheColumn()
Dim i As Long ' ループ用変数
Dim lngColumn As Long ' 列番号の最大値
Dim lngRow As Long ' 行番号の最大値
Dim objName As Name ' 名前オブジェクト
Dim strTitle As String ' カラム名
' アクティブシート上の名前を全て消す
For Each objName In ActiveSheet.Names
objName.Delete
Next objName
' 行番号の最大値と列番号の最大値を得る
lngRow = ActiveSheet.Cells.SpecialCells(xlLastCell).Row
lngColumn = ActiveSheet.Cells.SpecialCells(xlLastCell).Column
' 念のためにエラー処理ルーチンを有効化
On Error Resume Next
' 最初の列から最後の列までループ処理
For i = 1 To lngColumn
' 1行目の内容をカラム名として保持
strTitle = Cells(1, i).Text
' 2行目から最終行目までの範囲にカラム名を付ける
ActiveSheet.Names.Add Name:=strTitle, _
RefersToR1C1:="='" & ActiveSheet.Name & _
"'!R2C" & i & ":R" & lngRow & "C" & i
Next i
' エラー処理ルーチンを無効化
On Error GoTo 0
End Sub
各列にカラム名をつけるVBAの使用例
使用例を示します。
先ずA1にθという文字を入れ、A2~A20に0~360という値を入れます。
次いで、このマクロを実行すると、A2~A20の範囲にθという名前が付きます。
次に、B2にsinθという文字を入れ、B2~B20に、=SIN(RADIANS(θ))という式を入れます。
そうすると、B2~B20にsinθの値が計算されます(図では説明のため、式で表示しています)
更に、マクロをもう一度実行すると、B2~B20の範囲にsinθという名前が付きます。
θやsinθという名前は、グラフのプロットを指定する際にも使えます。
図において、Sheet1!θ、Sheet1!sinθという指定で、正弦波がプロットされていることが確認できます。
使い方のヒント
僕は、データベースから取って来たデータを解析する際に、このマクロを使っています。
2行目以降ではなく、1行目も含めた範囲に名前を付けたければ、下から5行目の”!R2C”を”!R1C”にすればOKです。
また、現在のコードでは、シート内で有効な名前が付きます。ブック内で有効な名前にしたい場合には、For Each文とNames.Add文の2か所にある、ActiveSheet.NamesをActiveWorkbook.Namesに変更することで可能になります。
どちらも必要に応じてお試しください。
コメント