중복된 것은 표시해주면서 하나만 뿌림

1. 4개씩 뿌릴 때 첫방송은 무조건 나온다.

2. 그 이후 중복된 방송은 맨 첫타임만 나온다.

3. 4번째 편성이 아닐 땐 '연속방송' 이라는 표시를 한다.

4개 중 첫번째와 나머지 세개의 표시 조건이 달라서 중복된 코드가 생기네요.

조건이 달라도 중복된 코드가 안 나오게 하고 싶은데...

Option Explicit
Sub OnAirFromThisTime()
 
    Dim rnG As Range
    Dim rngOnAir As Range
    Dim vOnAir() As String
    Dim intV As Integer
    Dim cntOffset As Integer
 
    Set rngOnAir = Range("B3", Cells(Rows.Count, "B").End(3))   '프로그램이름을 순환
    Range("D3").CurrentRegion.Clear '기존 자료 삭제
 
    For Each rnG In rngOnAir
        With rnG
 
            '첫 방송은 무조건 나와야 하므로 배열0에 삽입
            ReDim vOnAir(intV)
            vOnAir(intV) = .Offset(, -1) & " " & .Value
            If .Value = .Offset(1) Then vOnAir(intV) = vOnAir(intV) & " (연속방송)"
 
            Do Until intV = 3
                cntOffset = cntOffset + 1   '아래칸으로 이동
                If IsEmpty(.Offset(cntOffset)) Then Exit Do '빈칸이 나오면 반복문 종료
 
                If .Offset(cntOffset) <> .Offset(cntOffset - 1) Then    '현재 방송과 윗시간 방송이 다를 때 배열에 삽입
                    intV = intV + 1
                    ReDim Preserve vOnAir(intV)
                    vOnAir(intV) = .Offset(cntOffset, -1) & " " & .Offset(cntOffset)
 
                    If intV < 3 And .Offset(cntOffset) = .Offset(cntOffset + 1) Then    '아랫 방송과 같으면 연속방송 표시
                        vOnAir(intV) = vOnAir(intV) & " (연속방송)"
                    End If
                End If
            Loop
 
            .Offset(, 2) = Join(vOnAir, "  ")   '데이터 입력
        End With
 
        '변수 초기화
        Erase vOnAir()
        intV = 0
        cntOffset = 0
    Next rnG
End Sub

이시간이후 방송순서.xlsm