최장 연승 기록 집계하기

Sub successiveWin()
  ''' ---------- (1단계) ----------
  Dim shtX As Worksheet
  Dim rTbl As Range
  Dim rAreas As Range
  Dim rArea As Range
  Dim rA As Range
  Dim rWin As Range
  Dim rRow As Range
  Dim rX As Range
  
  On Error Resume Next
  Set shtX = Worksheets("연승기록")
  Set rTbl = shtX.Range("myTable").CurrentRegion
  Set rTbl = rTbl.Offset(1, 1).Resize(rTbl.Rows.Count - 1, rTbl.Columns.Count - 1)
  
  ''' ---------- (2단계) ----------
  With rTbl
      .Interior.ColorIndex = xlNone
      .Font.ColorIndex = 1
      With .Cells(.Columns.Count)
          .Offset(, 2).CurrentRegion.Clear
          .Offset(, 2).EntireColumn.HorizontalAlignment = xlCenter
          .Offset(-1, 2) = "연승 기록"
      End With
  End With

  ''' ---------- (3단계) ----------
  For Each rRow In rTbl.Rows
      For Each rX In rRow.Cells
          If rX = "O" Then
              If rArea Is Nothing Then
                  Set rArea = rX
              Else
                  Set rArea = rArea.Resize(, rArea.Cells.Count + 1)
              End If
          Else
KKK:
              If rAreas Is Nothing Then
                  Set rAreas = rArea
              Else
                  Set rAreas = Union(rAreas, rArea)
              End If
              Set rArea = Nothing
          End If
      Next
      If Not rArea Is Nothing Then GoTo KKK
      
  ''' ---------- (4단계) ----------
      For Each rA In rAreas.Areas
          rA.Font.ColorIndex = 3
          rA.Font.Bold = True
          If rWin Is Nothing Then
              Set rWin = rA
          Else
              If rWin.Cells.Count <= rA.Cells.Count Then Set rWin = rA
          End If
      Next
      
  ''' ---------- (5단계) ----------
      rWin.Interior.ColorIndex = 3
      rWin.Font.ColorIndex = 2
      rRow.Cells(rRow.Cells.Count).Offset(, 2) = rWin.Cells.Count
      Set rWin = Nothing
      Set rAreas = Nothing
  Next
End Sub
          

Dim shtX As Worksheet    ''' 워크시트 개체에 접근할 변수
Dim rTbl As Range        ''' 대진 결과표에 접근할 변수
Dim rAreas As Range      ''' 승리(O)한 영역 전체에 접근할 변수
Dim rArea As Range       ''' 승리한 영역에 개별적으로 접근할 변수
Dim rA As Range          ''' 승리 영역에 접근할 순환 변수
Dim rWin As Range        ''' 최장 연속 승리 영역에 접근할 변수
Dim rRow As Range        ''' 대진 결과표의 행 단위로 접근할 변수
Dim rX As Range          ''' 개별 셀에 접근할 순환 변수

On Error Resume Next     ''' 실행 도중 오류가 발생하더라도 다음 명령 수행
Set shtX = Worksheets("연승기록")
Set rTbl = shtX.Range("myTable").CurrentRegion    
                        ''' myTable의 인접 영역을 rTbl 변수에 할당
Set rTbl = rTbl.Offset(1, 1).Resize(rTbl.Rows.Count - 1, rTbl.Columns.Count - 1)
                        ''' 대진 결과표의 본문 영역을 rTbl 변수에 할당
          

With rTbl
  .Interior.ColorIndex = xlNone        ''' 셀 배경색 초기화
  .Font.ColorIndex = 1                 ''' 글자색 검정색으로 지정
  With .Cells(.Columns.Count)
      .Offset(, 2).CurrentRegion.Clear ''' 연승 내역을 기록할 주변 영역 지우기
      .Offset(, 2).EntireColumn.HorizontalAlignment = xlCenter
      .Offset(-1, 2) = "연승 기록"
  End With
End With
          

For Each rRow In rTbl.Rows        ''' 테이블의 개별 행 단위로 접근
For Each rX In rRow.Cells       ''' 개별 행의 각 셀 단위로 접근
    If rX = "O" Then            ''' 셀 값이 O(승리)라면...

      ''' rArea 변수에 아무 것도 할당되어 있지 않다면 rX를,
      ''' 이미 어떤 영역이 할당되어 있다면 다음 셀까지로 범위 확장
      If rArea Is Nothing Then
            Set rArea = rX
        Else
            Set rArea = rArea.Resize(, rArea.Cells.Count + 1)
        End If
    Else
KKK:
        ''' rAreas 변수에 아무 것도 할당되어 있지 않다면 rArea 변수 값을,
        ''' 이미 어떤 영역이 할당되어 있다면 기존 rAreas 영역과 rArea 영역 통합
        If rAreas Is Nothing Then
            Set rAreas = rArea
        Else
            Set rAreas = Union(rAreas, rArea)
        End If
        Set rArea = Nothing               ''' rArea 변수 초기화
    End If
  Next
If Not rArea Is Nothing Then GoTo KKK    ''' 마지막 rArea 영역을 처리하기 위해 KKK 레이블로 이동
          

For Each rA In rAreas.Areas         ''' rAreas의 각 영역(Area)에 접근
  rA.Font.ColorIndex = 3            ''' rA, 즉 값이 O인 셀의 글자색을 빨간색으로 지정
  rA.Font.Bold = True               ''' 굵은 글꼴로 지정

  ''' rWin 변수에 아무 것도 할당되어 있지 않다면 rA 변수 값을,
  ''' 이미 어떤 영역이 할당되어 있다면 rWin과 rA 영역의 크기를 비교하여 큰 영역을 rWin 변수에 할당
  If rWin Is Nothing Then        
      Set rWin = rA
  Else
      If rWin.Cells.Count <= rA.Cells.Count Then Set rWin = rA
  End If
Next
          

rWin.Interior.ColorIndex = 3      ''' 셀 배경색을 빨간색으로 지정
rWin.Font.ColorIndex = 2          ''' 글자색을 흰색으로 지정
rRow.Cells(rRow.Cells.Count).Offset(, 2) = rWin.Cells.Count    
                  ''' 각 행의 가장 오른쪽 셀에서 2열 더 오른쪽으로 이동하여 연승 기록 삽입
Set rWin = Nothing                ''' rWin 변수 초기화
Set rAreas = Nothing              ''' rAreas 변수 초기화
Next