基本情報技術者試験H27秋期午後問8（疑似言語）VBAプログラム

Sub main()
    Dim str1 As String, str2 As String
    Dim Text(20) As String, Pat(20) As String
    Dim i As Integer
    str1 = "ACBBMACABABC"
    str2 = "ACAB"
'    str1 = "XYZABCABCDE"
'    str2 = "ABCAB"
    TextLen = Len(str1)
    For i = 1 To TextLen
        Text(i) = Mid(str1, i, 1)
        Debug.Print "Text("; i; ")="; Text(i)
    Next

    PatLen = Len(str2)
        For i = 1 To PatLen
        Pat(i) = Mid(str2, i, 1)
        Debug.Print "Pat("; i; ")="; Pat(i)
    Next
    Call BMMatch(Text, TextLen, Pat, PatLen)
End Sub

Sub BMMatch(ByRef Text() As String, TextLen, ByRef Pat() As String, PatLen)
    Dim i As Integer
    Dim Skip(26) As Integer, PText As Integer, PPat As Integer, PLast As Integer
    For i = 1 To 26
        Skip(i) = PatLen
'        Debug.Print "Skip("; i; ")="; Skip(i)
    Next
    For i = 1 To PatLen - 1
        Skip(index(Pat(i))) = PatLen - i
'        Debug.Print "Pat("; i; ")="; Pat(i)
'        Debug.Print "index(Pat("; i; "))="; index(Pat(i))
'        Debug.Print "Skip(index(Pat("; i; "))))="; Skip(index(Pat(i)))
        Debug.Print "+++Skip("; index(Pat(i)); ")="; Skip(index(Pat(i)))
    Next
    PLast = PatLen
    Debug.Print "PLast="; PLast, "PatLen="; PatLen
    Do While PLast <= TextLen
        PText = PLast
        PPat = PatLen
        Debug.Print "PText="; PText, "PPat="; PPat
        Debug.Print "Text="; Text(PText), "Pat="; Pat(PPat)
        Debug.Print "---------------------------------"

        Do While Text(PText) = Pat(PPat)
            If PPat = 1 Then
                Debug.Print "PText="; PText
                End
            End If
            PText = PText - 1
            PPat = PPat - 1
            Debug.Print "PText="; PText, "PPat="; PPat
            Debug.Print "Text="; Text(PText), "Pat="; Pat(PPat)
            Debug.Print "---------------------------------"
        Loop
        Debug.Print "PLast="; PLast
        PLast = PLast + Skip(index(Text(PLast)))
        Debug.Print "PLast="; PLast
    Loop
    Debug.Print "Result=-1"
End Sub

Function index(s) As Integer
    Dim ABCD As String
    Dim i As Integer
    ABCD = "ABCDEFGHIJKLMNOPQRSTUVWXYZ"
    For i = 1 To 26
        If s = Mid(ABCD, i, 1) Then
            Exit For
        End If
    Next
    index = i
End Function

実行結果

Text( 1 )=A
Text( 2 )=C
Text( 3 )=B
Text( 4 )=B
Text( 5 )=M
Text( 6 )=A
Text( 7 )=C
Text( 8 )=A
Text( 9 )=B
Text( 10 )=A
Text( 11 )=B
Text( 12 )=C
Pat( 1 )=A
Pat( 2 )=C
Pat( 3 )=A
Pat( 4 )=B
+++Skip( 1 )= 3 
+++Skip( 3 )= 2 
+++Skip( 1 )= 1 
PLast= 4      PatLen= 4 
PText= 4      PPat= 4 
Text=B        Pat=B
---------------------------------
PText= 3      PPat= 3 
Text=B        Pat=A
---------------------------------
PLast= 4 
PLast= 8 
PText= 8      PPat= 4 
Text=A        Pat=B
---------------------------------
PLast= 8 
PLast= 9 
PText= 9      PPat= 4 
Text=B        Pat=B
---------------------------------
PText= 8      PPat= 3 
Text=A        Pat=A
---------------------------------
PText= 7      PPat= 2 
Text=C        Pat=C
---------------------------------
PText= 6      PPat= 1 
Text=A        Pat=A
---------------------------------
PText= 6