ハッシュテーブル(連想配列)のクラスを作成しました
VBAには、ハッシュテーブルのようなデータ構造がありません。それでも、ハッシュテーブルがあると便利な事がありますので、ライブラリを自作してみました。
処理を簡単にするため、Excelシートを使ってハッシュテーブルを実現しました。ソースは下記のようになりました。
使い方を簡単に書いておきます。
1.ハッシュテーブルインスタンス生成
インスタンス生成は、次のように行います。
Dim hashTable As New HashTableClass Call hashTable.Initialize("マクロ用ハッシュテーブル", 1, 1) Call hashTable.Clear
インスタンスを生成した際は、Initializeプロシージャを必ず呼び出して、初期化処理を行ってください。
Initializeプロシージャの第1引数には、ユニークな名前を指定してください。指定したシートが存在しない場合は自動的に作成されます。第2,3引数にはシート内で使用するセルの位置を指定します。基本的には1,1でよいです。
さらに、VBAの前回起動時の値を削除するため、Clearプロシージャを呼び出します。
2.データアクセス
GetValue、SetValueプロシージャを使用してデータにアクセスしてください。全てのデータは文字列として扱われるため、必要に応じて型変換を行ってください。
以上で簡単なライブラリの簡単な説明を終わります。
' ハッシュクラス ' ' 指定されたシートを使用して連想配列を実現するクラスです。 ' ' 新規作成:2008/03/16 Option Explicit Private sheet As Worksheet Private startCell As Range ' コンストラクタ Private Sub Class_Initialize() End Sub ' 初期化処理 ' コンストラクタには引数を渡せないみたいだったので、 ' このSubプロシージャを作成しました。 Public Sub Initialize(sheetName As String, startRow As Integer, startColumn As Integer) Dim tmpSheet As Worksheet ' シートの存在チェック For Each tmpSheet In Worksheets If tmpSheet.name = sheetName Then Set sheet = tmpSheet End If Next ' シートがなければ作成 If sheet Is Nothing Then Worksheets.Add ActiveSheet.name = sheetName Set sheet = ActiveSheet End If Set startCell = sheet.Cells(startRow, startColumn) End Sub ' クリアする Public Sub Clear() ' シートの内容をクリアする sheet.Cells.ClearContents End Sub ' 連想配列から指定キーの値を取得する。 ' key - キー文字列 ' return - キーが存在した場合、対応する値を返却。 ' キーが見つからなかった場合、Nothingを返却。 Public Function GetValue(key As String) As String Dim cell As Range Set cell = GetCell(key) GetValue = cell.value End Function ' 連想配列へ値を設定する。 ' key - キー文字列 ' value - 設定する値 Public Sub SetValue(key As String, value As String) Dim cell As Range Set cell = GetCell(key) cell.value = value End Sub ' 連想配列から指定キーのセルを取得する。 ' 指定キーが存在しない場合、要素を追加してセルを返却する。 ' key - キー文字列 ' return - キーが存在した場合、対応する値を返却。 ' キーが見つからなかった場合、Nothingを返却。 Private Function GetCell(key As String) As Range Dim cell As Range Dim keyBuf As String Set cell = startCell Do While True keyBuf = cell.value If keyBuf = "" Then cell.value = key Exit Do End If If keyBuf = key Then Exit Do End If Set cell = cell.Offset(1, 0) Loop Set GetCell = cell.Offset(0, 1) End Function