' strlike v0.9 1998.6.16 ' ' 原作者 古口正巳 [koguchi@sf.airnet.ne.jp http://www.sf.airnet.ne.jp/koguchi/] ' ' VBにあるLIKE演算子は検索文字列が含まれるかどうかしか分かりません。 '  この関数は一致した文字列そのものを返します。 ' '  このプログラムはコード改変可能なフリーフェアであり、いかなる条件でも正しく動作する事を保証してません。 '  各自のリスクで実行して下さい。このプログラムを利用していかなるトラブルが発生しても関知しません。 ' '使用方法 ' strlike(str1, str2) ' str1は比較される文字列をstr2はlike演算子と等価な検索文字列を設定します。 ' 具体的にはlike演算子のヘルプやブックスオンラインを参照してください。 ' strlikeに返された文字列が長さ0の文字列意外の時は一致する文字列です。 Public Function strlike(str1 As String, str2 As String) As String Dim i1 As Integer 'str1 Counter Dim i2 As Integer 'str2 Counter Dim l1 As Integer 'str1 Length Dim l2 As Integer 'str2 Length Dim c1 As String Dim c2 As String Dim flgAll As Boolean '* flag l1 = Len(str1) l2 = Len(str2) If l1 = 0 Or l2 = 0 Then '比較文字列がなければ""を返す strlike = "" Exit Function End If strlike = "" flgAll = False i2 = 1 'str2 Counter init For i1 = 1 To l1 c1 = Mid(str1, i1, 1) c2 = Mid(str2, i2, 1) Select Case c2 Case "*" flgAll = True i1 = i1 - 1 i2 = i2 + 1 Case "?" 'なんでもOK strlike = strlike & c1 flgAll = False Case "#" '文字として評価できれば If IsNumeric(c1) Then strlike = strlike & c1 flgAll = False Else strlike = "" End If Case "[" If Mid(str2, i2 + 1, 1) = "!" Then If Mid(str2, i2 + 3, 1) = "-" And Mid(str2, i2 + 5, 1) = "]" Then If Not (c1 >= Mid(str2, i2 + 2, 1) And c1 <= Mid(str2, i2 + 4, 1)) Then strlike = strlike & c1 i2 = i2 + 5 Else strlike = "" flgAll = False End If Else If c1 = c2 Then strlike = strlike & c1 flgAll = False Else strlike = "" End If End If Else If Mid(str2, i2 + 2, 1) = "-" And Mid(str2, i2 + 4, 1) = "]" Then If c1 >= Mid(str2, i2 + 1, 1) And c1 <= Mid(str2, i2 + 3, 1) Then strlike = strlike & c1 flgAll = False i2 = i2 + 4 Else strlike = "" End If Else If c1 = c2 Then strlike = strlike & c1 flgAll = False Else strlike = "" End If End If End If Case Else '両方の文字は同じか If c1 = c2 Then strlike = strlike & c1 flgAll = False Else If flgAll Then strlike = strlike & c1 Else strlike = "" End If End If End Select If flgAll = False Then If strlike = "" Then 'もしも一致していたら比較文字を進め,してなかったら最初から比較 i2 = 1 Else i2 = i2 + 1 End If If i2 > l2 Then Exit For '一致する文字を発見 End If 'Debug.Print c1, c2, strlike, i1, i2, flgAll Next i1 If c2 <> "*" Then If i2 - 1 <> l2 Then strlike = "" 'Str2側の文字はすべて使われたか End If End Function