Tick-Tack-Toe : 第一回 オフラインリアルタイムどう書くの当日のお題 http://nabetani.sakura.ne.jp/hena/1/

Module1.vb

Option Explicit

Sub test()
    Debug.Assert TickTackToe("79538246") = "x won."
    Debug.Assert TickTackToe("35497162193") = "x won."
    Debug.Assert TickTackToe("61978543") = "x won."
    Debug.Assert TickTackToe("254961323121") = "x won."
    Debug.Assert TickTackToe("6134278187") = "x won."
    Debug.Assert TickTackToe("4319581") = "Foul : x won."
    Debug.Assert TickTackToe("9625663381") = "Foul : x won."
    Debug.Assert TickTackToe("7975662") = "Foul : x won."
    Debug.Assert TickTackToe("2368799597") = "Foul : x won."
    Debug.Assert TickTackToe("18652368566") = "Foul : x won."
    Debug.Assert TickTackToe("965715") = "o won."
    Debug.Assert TickTackToe("38745796") = "o won."
    Debug.Assert TickTackToe("371929") = "o won."
    Debug.Assert TickTackToe("758698769") = "o won."
    Debug.Assert TickTackToe("42683953") = "o won."
    Debug.Assert TickTackToe("618843927") = "Foul : o won."
    Debug.Assert TickTackToe("36535224") = "Foul : o won."
    Debug.Assert TickTackToe("882973") = "Foul : o won."
    Debug.Assert TickTackToe("653675681") = "Foul : o won."
    Debug.Assert TickTackToe("9729934662") = "Foul : o won."
    Debug.Assert TickTackToe("972651483927") = "Draw game."
    Debug.Assert TickTackToe("5439126787") = "Draw game."
    Debug.Assert TickTackToe("142583697") = "Draw game."
    Debug.Assert TickTackToe("42198637563") = "Draw game."
    Debug.Assert TickTackToe("657391482") = "Draw game."
End Sub

Function TickTackToe(ByVal Nums As String) As String
    Dim Patterns() As String
    Dim PatternsCount As Long
    Dim Names(1) As String
    Dim IsCompleted As Boolean
    Dim n As Long
    Dim i As Long
    Dim j As Long
    Dim Turn As Long
    Dim Opponent As Long
    Dim Pos As String
    Dim Result As String
    
    ' 縦横斜めのパターンを定義
    Patterns = Split("123,456,789,147,258,369,159,357", ",")
    PatternsCount = UBound(Patterns)
    ReDim MatchCount(1, PatternsCount) As Long
    For i = 0 To PatternsCount
        MatchCount(0, i) = 0
        MatchCount(1, i) = 0
    Next i
    Names(0) = "o"
    Names(1) = "x"
    IsCompleted = False
    n = Len(Nums) ' 手数は9までとし、それ以降は無視する
    If n > 9 Then
        n = 9
    End If

    For i = 1 To n
        Turn = (i - 1) Mod 2           ' 手番
        Opponent = IIf(Turn = 0, 1, 0) ' 相手
        Pos = Mid$(Nums, i, 1)         ' 指し手

        ' 既に指された手を指したら反則とし、対戦相手の勝ちとする
        If InStr(Left$(Nums, i - 1), Pos) Then
            Result = "Foul : " & Names(Opponent) & " won."
            Exit For
        End If
        
        ' 縦横斜めのいずれかのパターンにマッチしていたらカウントし、
        ' 3で揃ったことになる
        For j = 0 To PatternsCount
            If InStr(Patterns(j), Pos) Then
                MatchCount(Turn, j) = MatchCount(Turn, j) + 1
                If MatchCount(Turn, j) = 3 Then
                    Result = Names(Turn) & " won."
                    IsCompleted = True
                    Exit For
                End If
            End If
        Next j
        
        ' 縦横斜めのいずれかが揃っていたら終了
        If IsCompleted Then
            Exit For
        End If
    Next i
    
    ' ここまでで勝敗が決まっていなければ引き分け
    TickTackToe = IIf(Len(Result) > 0, Result, "Draw game.")
End Function