ExcelマクロVBA技術解説 | VBAクラスの作り方:列名のプロパティを自動作成する | ExcelマクロVBAの問題点と解決策、エクセルVBAの技術的解説



最終更新日:2019-02-18

VBAクラスの作り方:列名のプロパティを自動作成する


クラスに列名のプロパティを作成することで、入力支援が使えてコーディングが楽になりますが、
列数が多くなればVBAの記述量が増え、コーディングが大変になります。

入力支援が使えるのは良いが、
その事前準備があまりに大変ではやる気が失せてクラス作るのが面倒になってしまいます。


前もって断っておきますが、今回の方法を特段に勧めているわけではありません
こういう方法もあるということを紹介しているものです、
同様のプロパティをコピペで大量生産する必要があるような場合の参考になれば良いということです。


前回の続きになります。
VBAクラスの作り方:列名の入力支援と列移動対応
こちらで書いた列名のプロパティ部分を自動で作成するVBAを紹介します。

前回のVBAクラスの完成コード
Option Explicit

Private Ws As Worksheet

Public Property Set Worksheet(ByVal argWs As Worksheet)
  Set Ws = argWs
End Property

Public Property Get 顧客ID() As Long
  Static c As Long
  If c <> 0 Then 顧客ID = c: Exit Property
  c = getColumn("nm顧客ID")
  顧客ID = c
End Property

・・・列数だけプロパティが並んでいる・・・

Public Property Get 備考() As Long
  Static c As Long
  If c <> 0 Then 備考 = c: Exit Property
  c = getColumn("nm備考")
  備考 = c
End Property

Private Function getColumn(ByVal argName As String) As Long
  On Error Resume Next
  getColumn = Ws.Range(argName).Column
  If Err Then
    MsgBox "名前定義不正:" & argName
    End
  End If
End Function

上のVBAクラスの、
Public Property Get 顧客ID() As Long

Public Property Get 備考() As Long
ここは、名称だけが違うプロパティが繰り返されています。
コピペしつつ名称を変更すれば良いのですが、列数が多くなったら結構大変です。

そこで、このクラス自体をVBAで作成してしまおうということです。

列タイトルを、名前定義とプロパティ名に使う名称に変換する関数も使うので、
前もって、以下に掲載しておきます。

Private Function editName(ByVal strName As String) As String
  '記号の一覧は使用しそうな記号を適当に記載
  '名前定義とプロパティ名に使えない記号は_に置換
  Const cnsSymbol As String = "!""#$%&'()=-~^|\`@{[+;*:}]<,>.?/\ "
  Dim strSymbol As String
  
  'CrLfは消去
  strName = Replace(Replace(strName, vbCr, ""), vbLf, "")
  '空白(スペース)は消去
  strName = Replace(Replace(strName, vbCr, " "), vbLf, " ")
  '全角記号も対象
  strSymbol = cnsSymbol & StrConv(cnsSymbol, vbWide)
  
  '記号を_に置換
  Dim i As Integer
  For i = 1 To Len(strSymbol)
    strName = Replace(strName, Mid(strSymbol, i, 1), "_")
  Next
  If Right(strName, 1) = "_" Then
    strName = Left(strName, Len(strName) - 1)
  End If
  editName = strName
End Function

全体の機能と構成


サンプルして使うシート




シート名
顧客マスタ
フィールド:
顧客ID
氏名
氏名(カナ)
性別
生年月日
年齢
郵便番号
都道府県
電話番号
Email
備考



クラスで、列名の入力支援と列移動対応するための手順

・作成済のクラス(clsColumn)をエクスポートして雛形にする
・シートの列タイトルからクラスファイル(.cls)を出力
・クラスファイル(.cls)のインポート
・全てを連続実行できるように変更
・列番号のプロパティを自動作成するVBAの完成コード

以下で、順に説明します。

作成済のクラス(clsColumn)をエクスポートして雛形にする


VBAクラスの作り方:列名の入力支援と列移動対応
こちらで作成したクラスclsColumnsをエクスポートして、作成するクラスの雛形にします。

クラスを右クリックして、「ファイルのエクスポート」



出力ファイルはそのままの、clsColumns.cls
出力先はVBAを書いているブック(ThisWorkbook)と同一フォルダに入れてください。

出力された、clsColumns.clsをメモ帳等のテキストエディタで開いてください。

VERSION 1.0 CLASS
BEGIN
  MultiUse = -1 'True
END
Attribute VB_Name = "clsColumns"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Option Explicit

Private Ws As Worksheet

Public Property Set Worksheet(ByVal argWs As Worksheet)
  Set Ws = argWs
End Property

Public Property Get 顧客ID() As Long
  Static c As Long
  If c <> 0 Then 顧客ID = c: Exit Property
  c = getColumn("nm顧客ID")
  顧客ID = c
End Property

・・・途中省略・・・

Public Property Get 備考() As Long
  Static c As Long
  If c <> 0 Then 備考 = c: Exit Property
  c = getColumn("nm備考")
  備考 = c
End Property

Private Function getColumn(ByVal argName As String) As Long
  On Error Resume Next
  getColumn = Ws.Range(argName).Column
  If Err Then
    MsgBox "名前定義不正:" & argName
    End
  End If
End Function

このようになっていますので、
これを以下のように修正します。

VERSION 1.0 CLASS
BEGIN
  MultiUse = -1 'True
END
Attribute VB_Name = "【クラス名】"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Option Explicit

Private Ws As Worksheet

Public Property Set Worksheet(ByVal argWs As Worksheet)
  Set Ws = argWs
End Property

【追加プロパティ】
Private Function getColumn(ByVal argName As String) As Long
  On Error Resume Next
  getColumn = Ws.Range(argName).Column
  If Err Then
    MsgBox "名前定義不正:" & argName
    End
  End If
End Function

Option Explicitの手前までは、
クラスを管理するための内部コードになっています。
内容は特に気にするほどのものはありません。

Attribute VB_Name = "clsColumns"

Attribute VB_Name = "【クラス名】"

Public Property Get 顧客ID() As Long
 〜 Public Property Get 備考() As Long

【追加プロパティ】

このように変更して上書き保存してください。
このファイルをクラスのひな型として使います。
【・・・】は見たときにすぐにわかるような文字にしているだけで、
他と区別できるユニークな文字列ならなんでも構いません。

シートの列タイトルからクラスファイル(.cls)を出力


clsColumns.clsをひな型として、
・クラス名の設定
・全列のプロパティを追加
以上を行い、シート名.clsとして出力します。

Private Sub CreateVbaProperty()
  '前提環境設定
  Dim Ws As Worksheet '対象シート
  Dim OutPath As String '.cls出力フォルダ
  Dim NameRow As String '名前定義の行
  Set Ws = Worksheets("顧客マスタ")
  NameRow = 1
  OutPath = ThisWorkbook.Path & "\"
  
  'クラス名の決定
  Dim ClsName As String
  Dim ClsFile As String
  ClsName = "clsC" & editName(Ws.Name)
  ClsFile = ClsName & ".cls"
  
  'プロパティの雛形:作成済のクラスをコピペして編集
  Const cProp As String = _
    "Public Property Get 【列名】() As Long" & vbCrLf & _
    "  Static c As Long" & vbCrLf & _
    "  If c <> 0 Then 【列名】 = c: Exit Property" & vbCrLf & _
    "  c = getColumn(""nm【列名】"")" & vbCrLf & _
    "  【列名】 = c" & vbCrLf & _
    "End Property" & vbCrLf & vbCrLf
  
  'シートの列タイトルの名前定義からProperty作成
  Dim i As Long
  Dim sName As String '列名:プロパティ名
  Dim sProp As String 'プロパティ全体を入れる
  For i = 1 To Ws.Cells(NameRow, Ws.Columns.Count).End(xlToLeft).Column
    If Ws.Cells(NameRow, i) <> "" Then
      sName = editName(Ws.Cells(NameRow, i))
      sProp = sProp & Replace(cProp, "【列名】", sName)
    End If
  Next
  
  'clsColumns.clsを雛形としてclsファイルを作成
  Dim objFSO As New FileSystemObject
  Dim objTS As TextStream
  Dim sClass As String
  Dim sFile As String
  'clsColumns.clsを読み込む
  sFile = OutPath & "clsColumns.cls"
  Set objTS = objFSO.OpenTextFile(Filename:=sFile)
  sClass = CStr(objTS.ReadAll)
  '【クラス名】【追加プロパティ】置換
  sClass = Replace(sClass, "【クラス名】", ClsName)
  sClass = Replace(sClass, "【追加プロパティ】", sProp)
  '.clsファイルを出力
  sFile = OutPath & ClsFile
  Set objTS = objFSO.CreateTextFile(Filename:=sFile)
  objTS.Write sClass
  objTS.Close
  Set objFSO = Nothing
  Set objTS = Nothing
End Sub
※「ツール」→「参照設定」に、「Microsoft Scripting Runtime」にチェックを付ける。

VBAコードは特に難しい部分はないと思います。
変数名は短めにしています。
長いとWEB掲載したときには余計に見づらくなってしまうので。
また、変数の初期化は明示的に初期化するほうが良い場合もありますが、
掲載コードが長くなるので、既定をそのまま使っています。

Const cProp にあらかじめプロパティ記述のひな型を入れておきます。
これは、既に作成してあるクラスから、列のプロパティをコピペし、
列名部分を【列名】に変更し、改行(VbCrLf)を追加したものです。

clsColumns.cls を読み込み(上記ではFSOを使っています)、
【クラス名】はシート名から作成したものに置換
【追加プロパティ】は列名から作成したプロパティ全体で置換
そして、clsCシート名.clsで出力しています。

クラスファイル(.cls)のインポート


出力したクラスファイル、clsCシート名.cls
これがあればインポートすれば良いのですが、
せっかくなので自動でインポートするところまでやってみましょう。

事前準備
「VBA プロジェクト オブジェクト モデルへのアクセスを信頼する」
これにチェックを付けておく必要があります。

リボン「ファイル」→「オプション」→「セキュリ ティセンター」→「マクロの設定」



※この設定は、セキュリティを弱めるために危険性が増します。
 もちろん、そこを突いたプログラムを動作させなければ問題とはなりません。
 とはいえ、いつ何時そのような事態があるとも限りませんので、
 普段はオフにしておき、必要な時だけオンにすることをお勧めしておきます。

.clsファイルをインポートします。

Private Sub ClassImport()
  '.clsファイル
  Dim ClsFile As String
  ClsFile = ThisWorkbook.Path & "\clsC顧客マスタ.cls"
  
  '.clsのフルパスから、拡張子を除いたファイル名を作成
  Dim ClsName As String
  ClsName = Dir(ClsFile)
  If ClsName = "" Then
    MsgBox ".clsファイルがありません。"
    Exit Sub
  End If
  ClsName = Left(ClsName, InStrRev(ClsName, ".") - 1)
  
  'インポート
  With ThisWorkbook.VBProject
    On Error Resume Next '最初はclsColumnsがないので
    '元のclsはリネームしてバックアップ
    .VBComponents(ClsName).Name = ClsName & "_" & Format(Now(), "yyyymmddhhmmss")
    On Error GoTo 0
    .VBComponents.Import ClsFile
  End With
End Sub

.clsファイルのフルパスから、拡張子を除いたファイル名を作成していますが、
既に同名のクラスに対する処理を行うときに必要なために作成しています。
ここでは少々回りくどい方法をとっていますが、一つの方法として紹介をかねて書いたものです。
記述としては、FileSystemObjectを使ったほうが簡単に書けます。

元のclsはバックアップの意味でリネームして残しています。
リネームせずに削除する場合は、
.VBComponents.Remove .VBComponents(ClsName)
これで削除できます。
作成途中のテスト段階では、間違って消してしまわないように気を付けてください。

インポートは.clsファイルをフルパスで指定するだけです。

このプロシージャーは何回でも実行できます。
複数回実行すると、リネームされたクラスがそのたびに増えていきます。



履歴で作成されてたクラスは後で解放して消して構いません。
無駄なものを入れっぱなしにしておくと後でわからなくなりますので、
適宜解放してください。



全てを連続実行できるように変更


ここまで、それぞれ単体のプロシージャーとして、
2つのプロシージャーを紹介してきました。
前回作成した名前定義設定プロシージャと合わせて、一気に全てできるようにします。

シートごとに
・名前定義を設定
・シートの列タイトルからクラスファイル(.cls)を出力
・クラスファイル(.cls)のインポート
この一連の処理をまとめて実行できるようにします。

起動するメインのプロシージャーを作成し、
個別のプロシージャーで設定している情報を、このメインで設定して引き継ぐようにします。
必要な情報は、
・対象シート
・列タイトル行(名前定義行)
・.cls出力フォルダ
以上の3つになります。
出力フォルダは、ThisWorkbook.Pathで固定になっていますが、
今後変更したいときの為に、せっかくなのでメインで指定できるようにします。

ここまでで作成したプロシージャーでは、

Private Sub CreateVbaProperty()
  '前提環境設定
  Dim Ws As Worksheet '対象シート
  Dim OutPath As String '.cls出力フォルダ
  Dim NameRow As String '名前定義の行
  Set Ws = Worksheets("顧客マスタ")
  NameRow = 1
  OutPath = ThisWorkbook.Path & "\"

  'クラス名の決定
  ・・・

多少の違いはあっても、概ねこのような感じで先頭の方で指定しています。
そこで、これを以下のように、引数で受け取るように変更します。
CreateVbaPropertyについては、
呼び出し元に最終的に決定したクラス名を戻すようにFunctionにしました。
(値を戻す部分等は、完成コードをご覧ください。)

Private Function CreateVbaProperty(ByVal Ws As Worksheet, _
                  ByVal NameRow As Long, _
                  ByVal OutPath As String) As String
  'クラス名の決定
  ・・・

前回作成した名前定義とclsインポートについては、
Functionにする必要がないので、引数への変更だけになります。

最初から引数にするものを意識してプロシージャーを作成できればそれに越したことはありませんが、
今回のように単体でプロシージャーを作成し後から共通する部分を引数化する手法は、
最初の作成しやすさもありますが、
大きくなってしまったプロシージャーを分割するときに必要な手法になります。
これは必ず必要になってくる手法ですので、ぜひマスターすることをお勧めします。

ここまでできれば、メインのプロージャーでそれぞれを呼び出せば完成です。

列番号のプロパティを自動作成するVBAの完成コード


Option Explicit

'名前定義設定とclsファイル作成とインポート
Sub NameAndProperty()
  Dim Ws As Worksheet '対象シート
  Dim NameRow As Long '名前定義の行
  Dim OutPath As String '.cls出力フォルダ
  Dim ClsName As String 'クラス名
  OutPath = ThisWorkbook.Path & "\"
  
  Set Ws = ThisWorkbook.Worksheets("顧客マスタ")
  NameRow = 1 '名前定義の行
  
  '名前定義
  Call SetTitleName(Ws, NameRow)
  '.cls出力
  ClsName = CreateVbaProperty(Ws, NameRow, OutPath)
  
  If MsgBox("VBEの操作を許可しますか?", vbYesNo, "確認") = vbYes Then
    Call ClassImport(OutPath & ClsName)
    MsgBox "クラス(.cls)をインポートしました。"
  Else
    MsgBox "手動でクラス(.cls)をインポートしてください。"
  End If
End Sub

'表の列タイトルのセルにタイトル文字列より名前定義設定
Private Sub SetTitleName(ByVal Ws As Worksheet, _
             ByVal NameRow As Long)
  Const strPre As String = "nm" 'プリフィックスなので何でも良い
  Dim strName As String
  Dim i As Long
  With Ws
    For i = 1 To .Cells(NameRow, .Columns.Count).End(xlToLeft).Column
      If .Cells(NameRow, i) <> "" Then
        strName = editName(.Cells(NameRow, i))
        .Names.Add Name:=strPre & strName, _
              RefersTo:="=" & .Cells(NameRow, i).Address
      End If
    Next
  End With
End Sub

'表の列タイトルの名前定義からclsファイル作成
Private Function CreateVbaProperty(ByVal Ws As Worksheet, _
                  ByVal NameRow As Long, _
                  ByVal OutPath As String) As String
  'クラス名の決定
  Dim ClsName As String
  ClsName = "clsC" & editName(Ws.Name)
  CreateVbaProperty = ClsName & ".cls"
  
  'プロパティの雛形:作成済のクラスをコピペして編集
  Const cProp As String = _
    "Public Property Get 【列名】() As Long" & vbCrLf & _
    "  Static c As Long" & vbCrLf & _
    "  If c <> 0 Then 【列名】 = c: Exit Property" & vbCrLf & _
    "  c = getColumn(""nm【列名】"")" & vbCrLf & _
    "  【列名】 = c" & vbCrLf & _
    "End Property" & vbCrLf & vbCrLf
  
  'シートの列タイトルの名前定義からProperty作成
  Dim i As Long
  Dim sName As String '列名:プロパティ名
  Dim sProp As String 'プロパティ全体を入れる
  For i = 1 To Ws.Cells(NameRow, Ws.Columns.Count).End(xlToLeft).Column
    If Ws.Cells(NameRow, i) <> "" Then
      sName = editName(Ws.Cells(NameRow, i))
      sProp = sProp & Replace(cProp, "【列名】", sName)
    End If
  Next
  
  'clsColumns.clsを雛形としてclsファイルを作成
  Dim objFSO As New FileSystemObject
  Dim objTS As TextStream
  Dim sClass As String
  Dim sFile As String
  
  'clsColumns.clsを読み込む
  sFile = OutPath & "clsColumns.cls"
  Set objTS = objFSO.OpenTextFile(Filename:=sFile)
  sClass = CStr(objTS.ReadAll)
  
  '【クラス名】【追加プロパティ】置換
  sClass = Replace(sClass, "【クラス名】", ClsName)
  sClass = Replace(sClass, "【追加プロパティ】", sProp)
  
  '.clsファイルを出力
  sFile = OutPath & CreateVbaProperty
  Set objTS = objFSO.CreateTextFile(Filename:=sFile)
  objTS.Write sClass
  objTS.Close
  Set objFSO = Nothing
  Set objTS = Nothing
End Function

'クラスファイル(.cls)をインポート
Private Sub ClassImport(ByVal ClsFile As String)
  '.clsのフルパスから、拡張子を除いたファイル名を作成
  Dim ClsName As String
  ClsName = Dir(ClsFile)
  If ClsName = "" Then
    MsgBox ".clsファイルがありません。"
    Exit Sub
  End If
  ClsName = Left(ClsName, InStrRev(ClsName, ".") - 1)
  
  'インポート
  With ThisWorkbook.VBProject
    On Error Resume Next '最初はclsColumnsがないので
    '元のclsはリネームしてバックアップ
    .VBComponents(ClsName).Name = ClsName & "_" & Format(Now(), "yyyymmddhhmmss")
    On Error GoTo 0
    .VBComponents.Import ClsFile
  End With
End Sub

'記号は_に変換:名前定義とプロパティ名に使うので
Public Function editName(ByVal strName As String) As String
  '記号の一覧は使用しそうな記号を適当に記載
  '名前定義とプロパティ名に使えない記号は_に置換
  Const cnsSymbol As String = "!""#$%&'()=-~^|\`@{[+;*:}]<,>.?/\ "
  Dim strSymbol As String
  
  'CrLfは消去
  strName = Replace(Replace(strName, vbCr, ""), vbLf, "")
  '空白(スペース)は消去
  strName = Replace(Replace(strName, vbCr, " "), vbLf, " ")
  '全角記号も対象
  strSymbol = cnsSymbol & StrConv(cnsSymbol, vbWide)
  
  '記号を_に置換
  Dim i As Integer
  For i = 1 To Len(strSymbol)
    strName = Replace(strName, Mid(strSymbol, i, 1), "_")
  Next
  If Right(strName, 1) = "_" Then
    strName = Left(strName, Len(strName) - 1)
  End If
  editName = strName
End Function

先頭の、
Sub NameAndProperty()
これが起動するメインプロシージャーです。

マクロ実行の開始がわかるようにする意味も含めて、
最初にclsインポートについての確認メッセージを出すようにしてみました。

対象シートと名前定義の行を変更するだけで別のシートで使えます。
シート数が多いときはループする等で対応すれば良いでしょう。

細部については、お好みに合わせて変更してみてください。

最後に


今回は、クラスを作るVBAの紹介でした。
クラスを作るといっても、ロジックは自動では作れませんので、
(AIならできるようになる・・・)
単純な定型文の繰り返し等の記述をVBAで行うということです。

このようなものを作成すること自体に手間がかかりますが、
これは一度作ってしまえば使い回しができますし、
これでベースを作って後は手修正するという使い方でも良いと思います。

従って、何度も同じことをやる必要があるなら、
こういうツールを一度作っておけば、その後はコーディングの手間が大幅に減らせます。
※シートで関数を設定して文字列を大量に生成する方法もあります。
雛形の文字列(プロパティ文字列)をセルに入れておき、
SUBSTITUTE関数で置換する方法になります。
細かいことはできませんが、簡単にやれる利点があり応用範囲が広いので、
ぜひ覚えておいてください。
今回は名前定義が関係していることもありVBAで対応しました。

コピペできるものはコピペする、繰り返しコピペと修正があるならツール作成を考える。
このように段階的に考えてみると、全体の作業量が大きく変わってくるはずです。




同じテーマ「マクロVBA技術解説」の記事

VBAのクラスとは(Class,Property,Get,Let,Set)
VBAクラスの作り方:列名の入力支援と列移動対応
VBAクラスの作り方:列名のプロパティを自動作成する
VBAクラスの作り方:独自Rangeっぽいものを作ってみた
クラスを使って他ブックのイベントを補足する

新着記事 ・・・新着記事一覧を見る

Excelシートの複雑な計算式を解析するVBA|VBAサンプル集(2月18日)
VBAクラスの作り方:独自Rangeっぽいものを作ってみた|VBA技術解説(2月16日)
VBAクラスの作り方:列名のプロパティを自動作成する|VBA技術解説(2月14日)
VBAクラスの作り方:列名の入力支援と列移動対応|VBA技術解説(2月11日)
クラスを使って他ブックのイベントを補足する|VBA技術解説(2月6日)
Excelアドインの作成と登録について|VBA技術解説(2月3日)
参照設定、CreateObject、オブジェクト式の一覧|VBA技術解説(1月20日)
VBAでファイルを規定のアプリで開く方法|VBA技術解説(1月20日)
ドキュメントプロパティ(BuiltinDocumentProperties,CustomDocumentProperties)|VBA技術解説(1月19日)
他ブックへのリンクエラーを探し解除|VBAサンプル集(1月15日)

アクセスランキング ・・・ ランキング一覧を見る

1.最終行の取得(End,Rows.Count)|VBA入門
2.セルのコピー&値の貼り付け(PasteSpecial)|VBA入門
3.変数とデータ型(Dim)|ExcelマクロVBA入門
4.Range以外の指定方法(Cells,Rows,Columns)|VBA入門
5.RangeとCellsの使い方|ExcelマクロVBA入門
6.マクロって何?VBAって何?|ExcelマクロVBA入門
7.繰り返し処理(For Next)|ExcelマクロVBA入門
8.とにかく書いて見よう(Sub,End Sub)|VBA入門
9.定数と型宣言文字(Const)|ExcelマクロVBA入門
10.ひらがな⇔カタカナの変換|エクセル基本操作



  • >
  • >
  • >
  • VBAクラスの作り方:列名のプロパティを自動作成する

  • このサイトがお役に立ちましたら「シェア」「Bookmark」をお願いいたします。


    記述には細心の注意をしたつもりですが、
    間違いやご指摘がありましたら、「お問い合わせ」からお知らせいただけると幸いです。
    なお、掲載のVBAコードは自己責任で使ってください。万一データ破損等の損害が発生しても責任は負いません。





    このサイトがお役に立ちましたら「シェア」「Bookmark」をお願いいたします。

    本文下部へ

    ↑ PAGE TOP