類似文字列判定

' Similar(refs as 検索範囲, ref as 検索対象, deg as 類似度)

Function Similar(refs As Range, ref As Range, deg As Long) As Boolean

  Dim r As Range

  

  For Each r In refs

    If (r.Address <> ref.Address) And (Len(r.Value) > 0) Then

      If SimilarStrings(r.Value, ref.Value, deg) Then

        Similar = True

        Exit Function

      End If

    End If

  Next
  Similar = False

End Function
Private Function SimilarStrings(s1 As String, s2 As String, deg As Long)

  Dim i As Long

  

  For i = 1 To Len(s1) - deg + 1

    If InStr(1, s2, Mid(s1, i, deg)) > 0 Then

      SimilarStrings = True

      Exit Function

    End If

  Next
  SimilarStrings = False

End Function