Excel VBA 逆引き集 | ハッシュマップ高速化

Excel VBA
スポンサーリンク

ねらい：VBAでハッシュマップ（Dictionary）を使い倒し、照合・集計・検索を爆速化する

ハッシュマップはキーから値へ即座にアクセスできるデータ構造です。VBAでは Scripting.Dictionary を使うのが最速・最短。VLOOKUPの代替、マスタ照合、頻度集計、グルーピングなどを「配列I/O＋Dictionary」で組むと、数万〜数十万件でも固まらず完走します。貼って動くテンプレに、速度を左右する重要ポイントを深掘りして示します。

重要ポイントの深掘り

  • キー・値は配列で一括読み込みし、セル往復をゼロにすると劇的に速くなります。
  • Dictionaryは「追加と更新を同じ書き方」で行うのが基本。存在確認の分岐を減らしてCPUを節約します。
  • キーの正規化（Trim、大小統一、全半角統一）で“揺らぎ”を消すと、ミスヒットがなくなり速度も安定します。
  • 文字キーは LCase、数値キーは Long/Double のまま使うと、比較コストが小さく済みます。

基本テンプレ：Dictionaryの生成・照合・頻度集計

生成と安全な比較設定（Late Bindingで参照不要）

' ModHashBasics.bas
Option Explicit

Public Function NewDict(Optional ByVal textCompare As Boolean = True) As Object
    Dim d As Object: Set d = CreateObject("Scripting.Dictionary")
    ' 0=BinaryCompare, 1=TextCompare（大小区別なし）
    d.CompareMode = IIf(textCompare, 1, 0)
    Set NewDict = d
End Function
VB

マスタ照合（VLOOKUP代替：片側を辞書化して即参照）

' ModHashJoin.bas
Option Explicit

Public Sub JoinMasterFast(ByVal srcSheet As String, ByVal masterSheet As String)
    Dim wsS As Worksheet: Set wsS = Worksheets(srcSheet)
    Dim wsM As Worksheet: Set wsM = Worksheets(masterSheet)

    Dim aS As Variant, aM As Variant
    aS = wsS.Range("A1").CurrentRegion.Value    ' 元データ（キーはA列）
    aM = wsM.Range("A1").CurrentRegion.Value    ' マスタ（キーA列、値B列）

    Dim d As Object: Set d = NewDict(True)
    Dim r As Long
    For r = 2 To UBound(aM, 1)
        Dim k As String: k = LCase$(Trim$(CStr(aM(r, 1))))
        d(k) = aM(r, 2)                         ' 追加/更新を同じ書き方で
    Next

    Dim out() As Variant: ReDim out(1 To UBound(aS, 1), 1 To 1)
    out(1, 1) = "MasterValue"
    For r = 2 To UBound(aS, 1)
        Dim ks As String: ks = LCase$(Trim$(CStr(aS(r, 1))))
        If d.Exists(ks) Then
            out(r, 1) = d(ks)
        Else
            out(r, 1) = ""                      ' ヒットしない場合の扱いを固定
        End If
    Next
    wsS.Range("Z1").Resize(UBound(out, 1), 1).Value = out   ' 結果は一括書き込み
End Sub
VB

頻度集計（カウントは加算だけに集中）

' ModHashCount.bas
Option Explicit

Public Function CountFreq(ByVal rng As Range) As Object
    Dim a As Variant: a = rng.Value
    Dim d As Object: Set d = NewDict(True)
    Dim r As Long
    For r = 1 To UBound(a, 1)
        Dim k As String: k = LCase$(Trim$(CStr(a(r, 1))))
        d(k) = IIf(d.Exists(k), d(k) + 1, 1)
    Next
    Set CountFreq = d
End Function

Public Sub ShowFreq(ByVal rng As Range, ByVal outSheet As String)
    Dim d As Object: Set d = CountFreq(rng)
    Dim ws As Worksheet: Set ws = PrepareOutput(outSheet)
    Dim keys As Variant: keys = d.Keys
    Dim vals As Variant: vals = d.Items
    Dim i As Long
    ws.Range("A1").Value = "Key": ws.Range("B1").Value = "Count"
    For i = 0 To UBound(keys)
        ws.Cells(i + 2, "A").Value = keys(i)
        ws.Cells(i + 2, "B").Value = vals(i)
    Next
    ws.Columns.AutoFit
End Sub

Private Function PrepareOutput(ByVal name As String) As Worksheet
    Dim ws As Worksheet
    On Error Resume Next: Set ws = Worksheets(name): On Error GoTo 0
    If ws Is Nothing Then Set ws = Worksheets.Add: ws.Name = name
    ws.Cells.Clear
    Set PrepareOutput = ws
End Function
VB

高速化の核心：配列I/O、正規化、存在分岐の削減

配列I/Oで「読み・書き」を1回ずつにまとめる

  • 走査対象は Range.Value で丸ごと Variant 配列へ。セルごと操作はしない。
  • 結果も配列へ作り、最後に Resize で一括書き戻す。これが全体のスピードを決めます。

キー正規化を入口で固定する

  • Trim、LCase（または CompareMode=Text）で大小差を吸収。
  • 全半角統一や不要記号削除が必要なら、前処理関数を挟んでから辞書へ。
  • 正規化は1回だけ実施し、以降はそのキーで統一すると速くて安全。

存在確認の分岐を可能な限り減らす

  • 追加・更新は d(key) = value で統一。Exists の分岐は「ヒット時のみ別処理が必要なとき」に限定。
  • カウント加算は IIf(d.Exists(k), d(k) + 1, 1) の1行が定番。

複合キー・多段ルックアップ：ハッシュ設計を拡張する

複合キー（2列以上）を安全に束ねる

' ModHashComposite.bas
Option Explicit

Private Const SEP As String = Chr$(30) ' ありえない区切り文字で衝突回避

Public Function MakeKey2(ByVal k1 As Variant, ByVal k2 As Variant) As String
    MakeKey2 = LCase$(Trim$(CStr(k1))) & SEP & LCase$(Trim$(CStr(k2)))
End Function

Public Sub JoinWithTwoKeys(ByVal srcSheet As String, ByVal masterSheet As String)
    Dim wsS As Worksheet: Set wsS = Worksheets(srcSheet)
    Dim wsM As Worksheet: Set wsM = Worksheets(masterSheet)
    Dim aS As Variant: aS = wsS.Range("A1").CurrentRegion.Value
    Dim aM As Variant: aM = wsM.Range("A1").CurrentRegion.Value

    Dim d As Object: Set d = NewDict(True)
    Dim r As Long
    For r = 2 To UBound(aM, 1)
        Dim km As String: km = MakeKey2(aM(r, 1), aM(r, 2))  ' キー列A,B
        d(km) = aM(r, 3)                                     ' 値はC
    Next

    Dim out() As Variant: ReDim out(1 To UBound(aS, 1), 1 To 1)
    out(1, 1) = "Value"
    For r = 2 To UBound(aS, 1)
        Dim ks As String: ks = MakeKey2(aS(r, 1), aS(r, 2))
        out(r, 1) = IIf(d.Exists(ks), d(ks), "")
    Next
    wsS.Range("Z1").Resize(UBound(out, 1), 1).Value = out
End Sub
VB

多段ルックアップ（コード→ID→属性）を段積みで解決

  • マスタが複数段なら、辞書を段階的に用意（コード→ID、ID→属性）。
  • 1段目の結果をキーにして2段目辞書から即参照。線形のVLOOKUP連鎖より遥かに速いです。

グルーピング・集計：Dictionaryで「表を作る」設計

グループ別合計（キーごとに加算）

' ModHashGroup.bas
Option Explicit

Public Sub GroupSum(ByVal sheetName As String)
    Dim ws As Worksheet: Set ws = Worksheets(sheetName)
    Dim a As Variant: a = ws.Range("A1").CurrentRegion.Value ' A:Key, B:Value
    Dim d As Object: Set d = NewDict(True)

    Dim r As Long
    For r = 2 To UBound(a, 1)
        Dim k As String: k = LCase$(Trim$(CStr(a(r, 1))))
        Dim v As Double: v = CDbl(a(r, 2))
        d(k) = IIf(d.Exists(k), d(k) + v, v)
    Next

    Dim keys As Variant: keys = d.Keys
    Dim vals As Variant: vals = d.Items
    Dim out() As Variant: ReDim out(1 To d.Count, 1 To 2)
    Dim i As Long
    For i = 0 To d.Count - 1
        out(i + 1, 1) = keys(i)
        out(i + 1, 2) = vals(i)
    Next
    Dim wr As Worksheet: Set wr = PrepareOutput("Grouped")
    wr.Range("A1").Value = "Key": wr.Range("B1").Value = "Sum"
    wr.Range("A2").Resize(UBound(out, 1), 2).Value = out
    wr.Columns.AutoFit
End Sub
VB

キーポイントの深掘り

  • 加算対象は必ず数値へ明示変換（CDbl）。文字混在を許すと突然遅く・不安定になります。
  • 結果は「新シートへ一括書き込み→列幅自動調整」で締めると運用がスムーズです。

メモリ・速度最適化：現場で効く微調整

型の選び方で速度が変わる

  • 数値は Long/Double のまま辞書値に。Stringへ変換しない。
  • キーは String一択で揺らぎを消す。CompareMode=Text か LCase を統一。
  • 巨大データでは Keys/Items の取り出しを必要回数に限定（都度 .Items を呼ぶと遅くなる）。

分岐・関数呼びの削減

  • ループ内部の Trim/LCase は「事前に1回」へ寄せる。
  • d(key) = value の1行追加で Exists 分岐を消し、CPUパイプラインの乱れを減らす。

サイズ感の目安

  • 10万件程度はDictionary＋配列I/Oで実用。100万件はVBA単体だとギリギリ。CSVに分割、Power QueryやPowerShellとの併用を検討。

高度テンプレ：LRUキャッシュで“最近使ったキー”を高速維持

' CLruCache.cls（簡易LRU：Dictionary＋Queue）
Option Explicit

Private mMap As Object, mQueue As Collection, mCap As Long

Public Sub Init(ByVal capacity As Long)
    Set mMap = CreateObject("Scripting.Dictionary")
    Set mQueue = New Collection
    mCap = capacity
End Sub

Public Function Get(ByVal key As String) As Variant
    If mMap.Exists(key) Then
        Touch key
        Get = mMap(key)
    End If
End Function

Public Sub Put(ByVal key As String, ByVal value As Variant)
    If mMap.Exists(key) Then
        mMap(key) = value
        Touch key
    Else
        mMap(key) = value
        mQueue.Add key
        If mMap.Count > mCap Then
            Dim oldKey As String: oldKey = mQueue(1)
            mQueue.Remove 1
            mMap.Remove oldKey
        End If
    End If
End Sub

Private Sub Touch(ByVal key As String)
    Dim i As Long
    For i = 1 To mQueue.Count
        If mQueue(i) = key Then mQueue.Remove i: Exit For
    Next
    mQueue.Add key
End Sub
VB

使いどころの深掘り

  • 重い計算や外部参照の結果をキーでキャッシュすると、同キー再利用時の速度が跳ねます。
  • 容量は数千〜数万程度に。メモリとヒット率のバランスでチューニング。

導入手順と検証の道筋

手順

  • 小さな範囲（1000行）で JoinMasterFast を実行し、結果が瞬時に出るか確認。
  • CountFreq → ShowFreq で頻度表が一括で作成されるかを確認。
  • 複合キー JoinWithTwoKeys を使い、2列照合が正しく行われるかを検証。
  • GroupSum でグループ合計を作り、ピボット相当の速度を体感。

検証ポイント

  • セル往復が発生していない（すべて配列で処理している）こと。
  • キー正規化の方針（Trim/LCase/CompareMode）がブレていないこと。
  • ヒットしない場合の扱い（空文字や0）が仕様として固定されていること。

まとめ：配列I/O＋Dictionaryで「照合・集計・検索」を一段引き上げる

  • まず配列へ読み込み→Dictionaryで即参照・即加算→最後に一括書き戻し。
  • キーは正規化して揺らぎゼロ、存在分岐は極力削減。
  • 複合キーと多段辞書で複雑な照合も線形時間に近づける。
  • 必要に応じてキャッシュ・外部ツールを併用し、数十万件でも止めない。

スポンサーリンク
タイトルとURLをコピーしました