안녕하세요~

질문을 이해해 보도록 하겠습니다.

1. A1부터 오른쪽 끝(무한대 가정)까지 0 또는 1있다고 가정한다는 것은 오른쪽 방향으로 16384까지 가면서 셀값이 1 또는 0이 들어있다는 의미로 해석이 됩니다.

2. 패턴을 찾는데,
1개짜리 패턴은 현재 B1의 값이 1이니까 같은 값을 갖는 셀을 1개만 일단 찾으면 D1이고
B1 + 1은 왼쪽으로 한 칸 이동하면, A1입니다.
그리고 D1은 E1에서 1을 찾았으니까 D1 + 1(왼쪽으로 한 칸 이동)은 C1 입니다.
그래서 B1 + 1 과 A1은 같으니까 "O", D1 + 1과 C1은 같으니까 "O", 만약에 다르면 "X"로 마킹합니다.

3. 그 다음 2개짜리 패턴은 B1C1의 조합으로 10 이니까 이를 또 찾은면 F1G1인데,
여기서 B1C1 + 1 (왼쪽으로 한 칸이동)은 A1이고 F1G1 + 1 은 E1인데 각 각 1이므로 "O"로 마킹합니다.

4. 이러한 패턴은
"B1부터 길이를 1칸씩 늘려가며 패턴을 만들고, 오른쪽에서 동일 패턴을 1번만 찾은 뒤,
각 패턴의 ‘왼쪽 한 칸 값’을 비교하여 O / X를 판단한다."로 이해했습니다.

Option Explicit

Public Sub PatOX()
    On Error GoTo EH

    Dim ws As Worksheet: Set ws = ActiveSheet

    Dim stp As Long: stp = 0

    Dim eRow As Long: eRow = 1        '// 데이터 행
    Dim bCol As Long: bCol = 2        '// B열
    Dim eCol As Long                  '// 마지막 열(배열 기준)
    Dim oCol As Long: oCol = 1        '// 출력 시작열(A)

    Dim lRow As Long: lRow = 4        '// 라벨 행
    Dim rRow As Long: rRow = 5        '// 결과 행

    stp = 10
    Dim lc As Long
    lc = ws.Cells(eRow, ws.Columns.Count).End(xlToLeft).Column
    If lc <= bCol Then Exit Sub

    stp = 20
    Dim arr As Variant
    arr = ws.Range(ws.Cells(eRow, 1), ws.Cells(eRow, lc)).Value2

    stp = 30
    eCol = UBound(arr, 2)             '// 실제 읽힌 열로 재확정
    If eCol <= bCol Then Exit Sub

    Dim n As Long: n = eCol - bCol + 1
    If n < 2 Then Exit Sub

    stp = 40
    Dim sB() As Byte
    ReDim sB(1 To n)

    Dim i As Long, v As Variant
    For i = 1 To n
        v = arr(1, bCol + i - 1)
        If v = 1 Or v = "1" Then
            sB(i) = 49
        Else
            sB(i) = 48
        End If
    Next i

    stp = 50
    Dim Z() As Long
    Z = ZCal(sB, n)

    stp = 60
    Dim ans() As Long
    ans = AnsZ(Z, n)

    stp = 70
    '// 라벨 100개로 고정(단, n보다 크면 n까지만)
    Dim m As Long
    m = 100
    If m > n Then m = n

    stp = 80
    Dim out As Variant
    ReDim out(1 To 2, 1 To m)

    Dim aL As Variant: aL = arr(1, bCol - 1)

    Dim lab As String: lab = ""
    Dim fPos As Long, fCol As Long
    Dim ox As String

    For i = 1 To m
        '// 라벨은 100개까지 계속 생성
        lab = lab & Ltr(bCol + i - 1)
        out(1, i) = LCase$(lab) & "1"

        '// ans(i)=0이면 못찾음 => x
        fPos = ans(i)
        If fPos = 0 Then
            out(2, i) = "x"
        Else
            fCol = bCol + fPos - 1

            '// 경계 체크
            If fCol - 1 < 1 Or fCol - 1 > eCol Then
                out(2, i) = "x"
            Else
                If CStr(aL) = CStr(arr(1, fCol - 1)) Then ox = "o" Else ox = "x"
                out(2, i) = ox
            End If
        End If
    Next i

    stp = 90
    ws.Range(ws.Cells(lRow, oCol), ws.Cells(rRow, oCol + m - 1)).Value = out
    Exit Sub

EH:
    MsgBox "오류 " & Err.Number & vbCrLf & Err.Description & vbCrLf & _
           "stp=" & stp, vbCritical
End Sub


'// Z-Algorithm (경계 체크 강화)
Private Function ZCal(ByRef sB() As Byte, ByVal n As Long) As Long()
    Dim Z() As Long
    ReDim Z(1 To n)

    Dim L As Long, R As Long, i As Long, k As Long
    L = 1: R = 1
    Z(1) = 0

    For i = 2 To n
        If i <= R Then
            k = i - L + 1
            If k < 1 Or k > n Then
                Err.Raise 9, , "ZCal: k out (" & k & ")"
            End If
            Z(i) = R - i + 1
            If Z(k) < Z(i) Then Z(i) = Z(k)
        Else
            Z(i) = 0
        End If

        Do While (i + Z(i) <= n)
            If (1 + Z(i) < 1) Or (1 + Z(i) > n) Or (i + Z(i) < 1) Or (i + Z(i) > n) Then
                Err.Raise 9, , "ZCal: idx out"
            End If
            If sB(1 + Z(i)) <> sB(i + Z(i)) Then Exit Do
            Z(i) = Z(i) + 1
        Loop

        If i + Z(i) - 1 > R Then
            L = i
            R = i + Z(i) - 1
        End If
    Next i

    ZCal = Z
End Function

'// ans(L)=접두 길이 L이 다시 나타나는 최소 시작 위치
Private Function AnsZ(ByRef Z() As Long, ByVal n As Long) As Long()
    Dim hd() As Long, nx() As Long
    ReDim hd(0 To n)
    ReDim nx(0 To n)

    Dim i As Long, zL As Long
    For i = 2 To n
        zL = Z(i)
        If zL > 0 Then
            If zL < 0 Or zL > n Then Err.Raise 9, , "AnsZ: zL out"
            nx(i) = hd(zL)
            hd(zL) = i
        End If
    Next i

    Dim ans() As Long
    ReDim ans(1 To n)

    Dim minP As Long: minP = 0
    Dim L As Long, p As Long

    For L = n To 1 Step -1
        p = hd(L)
        Do While p <> 0
            If p < 0 Or p > n Then Err.Raise 9, , "AnsZ: p out"
            If minP = 0 Or p < minP Then minP = p
            p = nx(p)
        Loop
        ans(L) = minP
    Next L

    AnsZ = ans
End Function

'// 열번호 -> 열문자
Private Function Ltr(ByVal c As Long) As String
    Dim t As Long, m As Long, s As String
    t = c
    Do While t > 0
        m = (t - 1) Mod 26
        s = Chr$(65 + m) & s
        t = (t - 1) \ 26
    Loop
    Ltr = s
End Function

무한대로 진행하면,

셀 "문자 길이 제한" 때문에 에러가 발생합니다.

엑셀은 한 셀에 들어갈 수 있는 텍스트가 최대 32,767자인데,
라벨이 b1, bc1, bcd1처럼 길이가 계속 증가하므로 어느 순간 반드시 32,767자를 넘는 순간이 옵니다.

따라서, 작업을 진행하면서

'// 라벨 100개로 고정(단, n보다 크면 n까지만) 
Dim m As Long 
m = 100 
If m > n Then m = n

m값을 원하는 라벨 수만큼 제한을 두도록 합니다.