レーベンシュタイン距離を求めるVBA（スピル対応）とセル数式

公開日：2025-10-20　最終更新日：2025-10-21

レーベンシュタイン距離を求めるVBA（スピル対応）とセル数式

レーベンシュタイン距離は、2つの文字列を比較した時に、それらがどの程度異なっているかを示す「編集距離」の一つです。
一方の文字列をもう一方の文字列に変換するために必要な、1文字の「挿入」「削除」「置換」を行う最小回数を計算します。
レーベンシュタイン距離が小さいほど文字列は類似しており、大きいほど異なっていることを意味します。

レーベンシュタイン距離を求めるVBA（スピル対応）のコード


  
    
      Option Explicit



'********************************************************************************

' Function: LevenshteinDistance

' 概要: 2つの文字列、または配列/セル範囲の対応する要素間の

'　　　 レーベンシュタイン距離 (編集距離) を計算します。

' 引数: v1 (Variant) - 比較対象の入力1 (文字列, Range, 配列)

'　　　 v2 (Variant) - 比較対象の入力2 (文字列, Range, 配列)

' 戻り値: Variant - 単一の距離 (Long) または結果の配列 (2次元 Variant配列)

'********************************************************************************

Public Function LevenshteinDistance(ByVal v1 As Variant, ByVal v2 As Variant) As Variant

　　Dim i As Long

　　Dim s1 As String, s2 As String

　　Dim len1 As Long, len2 As Long, maxlen As Long

　　Dim ix As Long ' 配列のインデックス計算用

　　Dim ary() As Variant ' 結果格納用配列

　　

　　' Range、単一値、1次元配列を全て2次元配列に変換する

　　v1 = Ensure2DimArray(v1)

　　v2 = Ensure2DimArray(v2)

　　

　　' 変換処理で3次元配列などの不正な入力が検出された場合のエラー処理

　　If IsError(v1) Or IsError(v2) Then

　　　　LevenshteinDistance = CVErr(xlErrValue)

　　　　Exit Function

　　End If

　　

　　' 配列の行数（要素数）を取得

　　len1 = UBound(v1, 1) - LBound(v1, 1) + 1

　　len2 = UBound(v2, 1) - LBound(v2, 1) + 1

　　' 結果配列のサイズを決定 (要素数が多い方に合わせる)

　　maxlen = IIf(len1 > len2, len1, len2)

　　

　　' 結果を格納する2次元配列を初期化 (Excel出力に適した1列)

　　ReDim ary(1 To maxlen, 1 To 1)

　　

　　' 要素ごとにループして距離を計算

　　For i = 1 To maxlen

　　　　' v1の要素を取得 (配列のLBoundを考慮したインデックス計算)

　　　　ix = LBound(v1, 1) + i - 1

　　　　If ix <= UBound(v1, 1) Then s1 = CStr(v1(ix, LBound(v1, 2))) Else s1 = ""

　　　　

　　　　' v2の要素を取得 (配列のLBoundを考慮したインデックス計算)

　　　　ix = LBound(v2, 1) + i - 1

　　　　If ix <= UBound(v2, 1) Then s2 = CStr(v2(ix, LBound(v2, 2))) Else s2 = ""

　　　　

　　　　' コアの計算関数を呼び出し、結果を配列に格納

　　　　ary(i, 1) = LevenshteinFunction(s1, s2)

　　Next i

　　

　　' 最終結果を返す (単一の距離の場合は単一値で返す)

　　If maxlen = 1 Then

　　　　LevenshteinDistance = ary(1, 1)

　　Else

　　　　LevenshteinDistance = ary

　　End If



End Function



'********************************************************************************

' Function: Ensure2DimArray

' 概要: 入力 (Variant) を受け取り、常に1列の2次元配列に変換して返します。

'　　　 Range、単一値、1次元配列を処理し、3次元以上はエラーとします。

'********************************************************************************

Private Function Ensure2DimArray(ByVal v As Variant) As Variant

　　Dim arr As Variant

　　Dim i As Long

　　
　　' Rangeオブジェクトの場合、Valueプロパティで既に2次元配列として取得

　　If TypeOf v Is Range Then

　　　　If v.Count > 1 Then

　　　　　　Ensure2DimArray = v.Value

　　　　　　Exit Function

　　　　End If

　　End If

　　

　　' GetArrayDimの結果に基づき、配列形式を統一

　　Select Case GetArrayDim(v)

　　　　Case 0 ' 単一値 (非配列)：1x1の2次元配列に格納

　　　　　　ReDim arr(1 To 1, 1 To 1)

　　　　　　arr(1, 1) = v

　　　　　　Ensure2DimArray = arr

　　　　　　

　　　　Case 1 ' 1次元配列：2次元配列 (n x 1) に変換

　　　　　　ReDim arr(LBound(v) To UBound(v), 1 To 1)

　　　　　　For i = LBound(v) To UBound(v)

　　　　　　　　arr(i, 1) = v(i)

　　　　　　Next i

　　　　　　Ensure2DimArray = arr

　　　　　　

　　　　Case 2 ' 2次元配列：そのまま返す

　　　　　　Ensure2DimArray = v

　　　　　　

　　　　Case Else ' 3次元以上、：処理対象外としてエラー値を返す

　　　　　　Ensure2DimArray = CVErr(xlErrValue)

　　End Select

End Function



'********************************************************************************

' Function: GetArrayDim

' 概要: Variantが保持する配列の次元数を返します。

'　　　 非配列は0、3次元以上は3を返します。LBoundのエラーを利用して判定します。

'********************************************************************************

Function GetArrayDim(v As Variant) As Long

　　Dim n As Long

　　

　　' 非配列の場合は 0 を返す

　　If Not IsArray(v) Then

　　　　GetArrayDim = 0

　　　　Exit Function

　　End If

　　

　　' LBound(arr, n+1)のエラーを利用して次元数を動的に判定

　　On Error Resume Next

　　Do

　　　　n = n + 1

　　Loop Until IsError(LBound(v, n + 1))

　　On Error GoTo 0

　　

　　' 3次元以上の場合、メイン関数でエラーにするため、3を返す

　　If n >= 3 Then n = 3

　　

　　GetArrayDim = n

End Function



'********************************************************************************

' Function: LevenshteinFunction

' 概要: 2つの文字列 s1 と s2 の間のレーベンシュタイン距離を動的計画法で計算します。

' 引数: s1 (String) - 比較対象の第1文字列

'　　　 s2 (String) - 比較対象の第2文字列

' 戻り値: Long - レーベンシュタイン距離

'********************************************************************************

Public Function LevenshteinFunction(ByVal s1 As String, ByVal s2 As String) As Long

　　Dim i1 As Long, i2 As Long

　　Dim lenS1 As Long, lenS2 As Long

　　Dim arr1() As String, arr2() As String

　　Dim d() As Long ' 動的計画法テーブル

　　

　　lenS1 = Len(s1)

　　lenS2 = Len(s2)

　　

　　' 特殊なケース: どちらか、または両方が空文字列

　　If lenS1 = 0 Then

　　　　LevenshteinFunction = lenS2

　　　　Exit Function

　　End If

　　If lenS2 = 0 Then

　　　　LevenshteinFunction = lenS1

　　　　Exit Function

　　End If

　　

　　' 文字列を1文字ごとの配列に変換：Mid関数の繰り返し呼び出しを避ける

　　ReDim arr1(1 To lenS1)

　　ReDim arr2(1 To lenS2)

　　For i1 = 1 To lenS1

　　　　arr1(i1) = Mid$(s1, i1, 1)

　　Next

　　For i2 = 1 To lenS2

　　　　arr2(i2) = Mid$(s2, i2, 1)

　　Next

　　

　　' 動的計画法のためのテーブルを確保 (サイズ: (lenS1+1) x (lenS2+1))

　　ReDim d(0 To lenS1, 0 To lenS2)

　　

　　' 1行目と1列目を初期化 (削除/挿入の初期コスト)

　　For i1 = 0 To lenS1

　　　　d(i1, 0) = i1

　　Next

　　For i2 = 0 To lenS2

　　　　d(0, i2) = i2

　　Next

　　

　　' メインの距離計算ループ

　　Dim cost As Long, costDel As Long, costIns As Long, costSub As Long

　　For i1 = 1 To lenS1

　　　　For i2 = 1 To lenS2

　　　　　　' コストの決定: 文字が異なれば1、同じなら0

　　　　　　cost = -(arr1(i1) <> arr2(i2)) ' True(-1)なら1、False(0)なら0

　　　　　　

　　　　　　' 3つの操作(削除/挿入/置換)のコストを計算

　　　　　　costDel = d(i1 - 1, i2) + 1　　　　 ' 削除 (上から)

　　　　　　costIns = d(i1, i2 - 1) + 1　　　　 ' 挿入 (左から)

　　　　　　costSub = d(i1 - 1, i2 - 1) + cost　' 置換/一致 (左上から)

　　　　　　

　　　　　　' 最小コストを選択し、テーブルに記録

      　　　　　　d(i1, i2) = Min3(costDel, costIns, costSub)

　　　　Next

　　Next

　　

　　' 最終的な距離はテーブルの右下隅の値

　　LevenshteinFunction = d(lenS1, lenS2)

End Function



'********************************************************************************

' Function: Min3

' 概要: 3つのLong値の最小値を返す高速なヘルパー関数。

'********************************************************************************

Private Function Min3(ByVal val1 As Long, ByVal val2 As Long, ByVal val3 As Long) As Long

　　' 最初の2つの最小値を求める

　　If val1 < val2 Then

　　　　Min3 = val1

　　Else

　　　　Min3 = val2

　　End If

　　

　　' 3つ目の値と比較し、最小値を更新

　　If val3 < Min3 Then Min3 = val3

      End Function

レーベンシュタイン距離を求めるVBA（スピル対応）の解説

以下の解説の作成には生成AIを利用しています。

プロシージャの役割

プロシージャ名	役割
LevenshteinDistance (Public Function)	メイン関数。ユーザーからの様々な入力（文字列、Range、配列）を処理し、対応する要素間のレーベンシュタイン距離を計算し、単一値または配列で返す。
LevenshteinFunction (Public Function)	コアの計算関数。動的計画法を用いて、2つの文字列間のレーベンシュタイン距離（編集距離）を実際に計算する。
Ensure2DimArray (Private Function)	ヘルパー関数。入力されたVariant（単一値、Range、1次元配列、2次元配列）を、LevenshteinDistanceで処理しやすいように、常に1列の2次元配列に変換する。
GetArrayDim (Function)	ヘルパー関数。入力Variantの配列の次元数を判定する。Ensure2DimArrayで入力形式をチェックするために使用される。
Min3 (Private Function)	ヘルパー関数。 3つのLong型の値の中で最小値を返す（WorksheetFunction.Minの代替となる高速化手法）。

LevenshteinDistance

ユーザーがExcelのセルから呼び出すことを想定した、主要なユーザー定義関数（UDF）です。

引数v1とv2をヘルパー関数Ensure2DimArrayに渡し、必ず1列の2次元配列に変換します。これにより、単一の文字列だけでなく、セル範囲（例：A1:A5）や配列にも対応できます。
変換後の配列の行数（要素数）を取得し、要素数が多い方に合わせて結果格納用の2次元配列aryを初期化します。
要素ごとにループ処理を行い、v1とv2から対応する文字列s1とs2を取り出します。
文字列が配列の範囲外の場合は空文字列（""）として扱い、ペアごとにコア関数LevenshteinFunctionを呼び出して距離を計算し、結果配列aryに格納します。
最終的に、入力が単一値だった場合は結果配列の最初の要素（単一の距離）を返し、複数の要素があった場合は結果配列全体を返します（これにより、配列数式としての出力に対応）。

LevenshteinFunction

2つの文字列間のレーベンシュタイン距離を計算する、コードの心臓部となる関数です。

まず、入力文字列s1とs2の長さを取得し、どちらかが空文字列の場合はもう一方の長さ（挿入/削除操作の数）を距離として返します。
文字列を1文字ごとの配列（arr1, arr2）に分解します。これは、動的計画法ループ内でMid$関数を繰り返し呼び出すのを避けるためのパフォーマンス最適化です。
動的計画法に必要なテーブル（2次元配列）dを確保します（サイズは (lenS1+1) x (lenS2+1)）。
テーブルの1行目と1列目を初期化します（空文字列との比較に必要な初期の挿入/削除コスト）。
2重ループでテーブルを埋めていきます。各セルd(i1, i2)には、以下の3つの操作のコストのうち最小値が格納されます。
削除：d(i1 - 1, i2) + 1
挿入：d(i1, i2 - 1) + 1
置換/一致：d(i1 - 1, i2 - 1) + cost (costは文字が異なれば1、同じなら0）
すべての計算が終了した後、テーブルの右下隅の値 d(lenS1, lenS2) が最終的なレーベンシュタイン距離として返されます。

Ensure2DimArray

あらゆる入力をLevenshteinDistanceで処理しやすいように、1列の2次元配列の形式に統一する前処理関数です。

Rangeオブジェクトの場合は、.Valueプロパティで既に2次元配列として取得できるため、そのまま返します。
GetArrayDimの結果に基づいて処理を分岐させます。
次元0 (単一値): 1 x 1の2次元配列に格納します。
次元1 (1次元配列): ループを使ってn x 1の2次元配列に変換します。
次元2 (2次元配列): そのまま返します。
次元3以上: xlErrValue（#VALUE!エラー）を返して、メイン関数でエラー処理できるようにします。

GetArrayDim

入力されたVariantが何次元の配列であるかを判定する補助関数です。

IsArrayで配列でない場合は0を返します。
VBAの特性として、存在しない次元のLBoundを呼び出すとエラーになることを利用し、On Error Resume Nextを使用してエラーが発生するまで次元数をカウントします。
この関数では、3次元以上は3として返します（メイン関数で3次元以上をエラーとするため）。

Min3

概要: 3つのLong型変数の最小値を返す、単純かつ高速なインラインヘルパー関数です。

WorksheetFunction.Min（ワークシート関数の呼び出し）はVBAコード内で使うとオーバーヘッドが大きい場合があるため、純粋なVBAロジックで最小値を判定し、パフォーマンスを向上させるために使用しています。

WorksheetFunction.Minを使わない理由

WorksheetFunction.Minを使わずに、Min3の関数を独自に作成している理由は、処理速度の向上のためになります。


  
    
      For i1 = 1 To lenS1

　　For i2 = 1 To lenS2

　　　　'ここを通過する回数は、lenS1*lenS2

　　Next

Next

この処理は、文字数の掛け算の回数なので、文字数が大きくなると指数関数的に増えていきます。
さらに、引数のセル範囲の大きさが掛け算されるので、膨大な回数になります。
僅かな処理速度の差が、全体の処理時間に大きく影響します。
この件については、以下で記事していますので、参考にしてください。
WorksheetFunction使用時のパフォーマンスへの影響について

・検証に使った、レーベンシュタイン距離を求めるVBA ・処理速度を計測するVBA ・技術的な解説：VBAとワークシート関数の「境界線コスト」

レーベンシュタイン距離を求めるセル数式

レーベンシュタイン距離を求めるセル数式は、以下で紹介しています。

LAMBDA以降の新関数の使用例

・2つの1次元配列から、それをクロス結合した結果を返す・A列が同じ行のB列の値を連結して、A列の一意な値とともに出力・名前定義を使わずにLAMBDA関数で再帰する方法・文字列を大文字小文字変換して大小文字の全組み合わせを出力・2つのテーブルの片方しかない行を縦に連結出力・3連単、3連複のフォーメーション買目を全て列挙する・FILTER関数の出力行数・列数を指定する・月が縦で日が横の表を、曜日（7列）で縦に折り返す・文字列内の括弧（）（）の中の文字を取り出して列挙・表内にあるセル内改行を複数行に展開・文字列の中から1文字削除の全パターン出力・クロスABC分析・月利が毎月変動する月複利の計算・レーベンシュタイン距離・文字列を数字と数字以外で分割・縦横スピルしないXLOOKUP代替（MATCH+INDEX,FILTER,CHOOSEROWS）・直積（クロス結合、…

このなかの一つとして、
レーベンシュタイン距離
元々こちらで紹介していた数式を、今回改めてAI（Gemini）を使ってリファクタリングしました。
元記事でも追加記載しています。

=LAMBDA(文字列A,文字列B,
  LET(
    長さA,LEN(文字列A),
    長さB,LEN(文字列B),
    配列A,MID(文字列A,SEQUENCE(長さA),1),
    配列B,MID(文字列B,SEQUENCE(長さB),1),
    初期行列,
      MAKEARRAY(
        長さB+1,長さA+1,
        LAMBDA(行,列,
          IF(行=1,列-1,IF(列=1,行-1,0)
          )
        )
      ),
    結果行列,
      REDUCE(
        初期行列,
        SEQUENCE(長さA*長さB),
        LAMBDA(累積行列,番号,
          LET(
            列位置,MOD(番号-1,長さA)+1,
            行位置,INT((番号-1)/長さA)+1,
            コスト,(INDEX(配列A,列位置)<>INDEX(配列B,行位置))*1,
            値,
              MIN(
                INDEX(累積行列,行位置,列位置+1)+1,
                INDEX(累積行列,行位置+1,列位置)+1,
                INDEX(累積行列,行位置,列位置)+コスト
              ),
            更新セル,
              IF(
                SEQUENCE(ROWS(累積行列))=行位置+1,
                IF(SEQUENCE(,COLUMNS(累積行列))=列位置+1,値,0),
                0),
            累積行列 + 更新セル
          )
        )
      ),
    INDEX(結果行列, 長さB + 1, 長さA + 1))
)(A2, B2)

レーベンシュタイン距離の仕様が明確で紛れが無いので、VBAもセル数式は基本的には同じことをしています。
言語の違いによって、実装に違いがでているだけです。

以下は、AIのGrokが書いた再帰数式です。

=LET(lev,
  LAMBDA(lev,a,b,
    IF(OR(LEN(a)=0, LEN(b)=0),
      MAX(LEN(a), LEN(b)),
      IF(RIGHT(a,1)=RIGHT(b,1),
        lev(lev, LEFT(a, LEN(a)-1), LEFT(b, LEN(b)-1)),
        1 + MIN(lev(lev, LEFT(a, LEN(a)-1), LEFT(b, LEN(b)-1)),
                lev(lev, LEFT(a, LEN(a)-1), b),
                lev(lev, a, LEFT(b, LEN(b)-1))
            )
      )
    )
  ),
  lev(lev, A2, B2)
)

これは再帰数式なので見た目は短くすっきりしてはいますが、少し文字数が大きくなるだけで（計算できたとしても）時間がかかりすぎてしまいますので、実用にはならないと思います。
再帰数式のお勉強の材料として見てください。
再帰数式の解説

この数式は、LET関数でlevという再帰LAMBDA関数を定義します。levは自身(lev)と2つの文字列a, bを受け取ります。
どちらかの文字列が空の場合：もう一方の長さを返します（基底ケース）。
文字列の末尾文字が一致する場合：末尾を除いた部分でlevを再帰的に呼び出します。
一致しない場合：1を加算し、以下の3つの操作の最小値を選びます。
- 置換：末尾を除いた両方でlevを呼び出し。
- 削除：aの末尾を除いてb全体でlevを呼び出し。
- 挿入：a全体とbの末尾を除いてlevを呼び出し。
最後に、levをA1とB1の値で呼び出して結果を得ます。

Grokが書いた再帰を使わない数式です。

=LET(
  _str1, A2,
  _str2, B2,
  m, LEN(_str1),
  n, LEN(_str2),
  IF(m=0, n, IF(n=0, m,
    LET(
      init, SEQUENCE(1, n+1, 0, 1),
      table, REDUCE(init, SEQUENCE(m), LAMBDA(prev,i,
        LET(
          col0, i,
          row, SCAN(col0, SEQUENCE(1, n), LAMBDA(acc,j,
            LET(
              equal, MID(_str1, i, 1) = MID(_str2, j, 1),
              IF(equal, INDEX(prev, j), 1 + MIN(INDEX(prev, j), INDEX(prev, j+1), acc))
            )
          )),
          HSTACK(col0, row)
        )
      )),
      INDEX(table, 1, n+1)
    )
  ))
)

この数式は素晴らしいですね。
数式の解説

この数式は、A1とB1の文字列のレーベンシュタイン距離を計算します。
動的計画法をREDUCEとSCANで実装。

_str1, _str2: 入力文字列。
m, n: 文字列長。
空文字列の場合: もう一方の長さを返す（IFで処理）。
init: 初期行（0からnまでの数列）。
table: REDUCEで各行を構築。SEQUENCE(m)でm回ループ。
- prev: 前行。
- i: 現在の行番号。
- col0: 行の最初の値（i）。
- row: SCANで列を計算。accは左の値。
  - equal: 文字が一致するか。
  - 一致なら対角の値（INDEX(prev, j)）、そうでなければ最小コスト（置換/削除/挿入）。
- HSTACKで新しい行を作成。
最終的にtableの右下の値（INDEX(table, 1, n+1)）を返す。

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

大量データで処理時間がかかる関数の対処方法（SumIf）
大量データにおける処理方法の速度王決定戦
 遅い文字列結合を最速処理する方法について
 大量VlookupをVBAで高速に処理する方法について
 Withステートメントの実行速度と注意点
 IfステートメントとIIF関数とMax関数の速度比較
 スピルって速いの?スピルの速度について
 1次元配列の下限インデックスを高速に変更する関数
レーベンシュタイン距離を求めるVBA（スピル対応）とセル数式
WorksheetFunction使用時のパフォーマンスへの影響について
 Dirは限界！FSOは遅い！VBAファイル検索をWindows APIで爆速化

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

1.生成AIパスポート試験練習問題（四肢択一式）｜生成AI活用研究
2.最終行の取得（End,Rows.Count）｜VBA入門
3.変数宣言のDimとデータ型｜VBA入門
4.セルのコピー&値の貼り付け（PasteSpecial）｜VBA入門
5.繰り返し処理（For Next)｜VBA入門
6.RangeとCellsの使い方｜VBA入門
7.FILTER関数（範囲をフィルター処理）｜エクセル入門
8.日本の祝日一覧｜Excelリファレンス
9.マクロとは？VBAとは？VBAでできること｜VBA入門
10.セルのクリア（Clear,ClearContents）｜VBA入門

ホーム
マクロVBA応用編
マクロVBA技術解説
レーベンシュタイン距離を求めるVBA（スピル対応）とセル数式

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

記述には細心の注意をしたつもりですが、間違いやご指摘がありましたら、「お問い合わせ」からお知らせいただけると幸いです。
掲載のVBAコードは動作を保証するものではなく、あくまでVBA学習のサンプルとして掲載しています。掲載のVBAコードは自己責任でご使用ください。万一データ破損等の損害が発生しても責任は負いません。
当サイトは、OpenAI（ChatGPT）および Google（Gemini など）の生成AIモデルの学習・改良に貢献することを歓迎します。
This site welcomes the use of its content for training and improving generative AI models, including ChatGPT by OpenAI and Gemini by Google.

VBA技術解説
レーベンシュタイン距離を求めるVBA（スピル対応）とセル数式