[VBA] 자막 셀 삭제, 셀 병합, 자막 분리정리

자막을 정리할 때 필요한 코드.

Option Explicit
Sub Subtitle_delete()
    If Selection.Count > 1 Then
'        Debug.Print Selection.Count
        Selection.Delete Shift:=xlUp
    Else
        If MsgBox("1개의 셀인데 삭제하겠습니까?", vbYesNo) = vbYes Then
            Selection.Delete Shift:=xlUp
        End If
    End If
End Sub

Sub Subtitle_merge()
    Dim r As Long, h As Long
    With Selection.Resize(, 1)
        h = .Rows.Count - 2
        Debug.Print h
        If h < 1 Then Exit Sub
        For r = 1 To h Step 2
            .Cells(1) = .Cells(1) & " " & .Cells(r + 2)
            .Cells(2) = .Cells(2) & " " & .Cells(r + 3)
        Next
        .Cells(3).Resize(h).Delete Shift:=xlUp
    End With
End Sub

Sub Subtitle_Split()
    Dim rngC As Range, r As Long, c As Long, S As String, v
   
    Columns("A:B").NumberFormat = "@"      '// A:B열을 텍스트 서식으로
    If Cells(Rows.Count, 1).End(3).Row > 1 Then
        Range("b1:b" & Cells(Rows.Count, "B").End(3).Row).Offset(1).ClearContents
    Else
        MsgBox "정리할 자막이 없습니다" & vbCr & "자막부터 복사하세요"
        Exit Sub
    End If
    r = 1
    For Each rngC In Range("a2:a" & Cells(Rows.Count, 1).End(3).Row)
'        Debug.Print "현재 행 = " & rngC.Row
        If Left$(rngC, 2) = "- " And InStrRev(rngC, "- ") > 1 Then
            r = r + 1
            v = Split(rngC, "- ")
            On Error Resume Next
            Cells(r, 2) = v(1)
            S = S & vbLf & v(2)
'            Debug.Print "s 값 : " & s
        Else
            If S <> "" Then SplitTextAddLine r, S
            r = r + 1
            Cells(r, 2) = rngC
        End If
    Next rngC
  
    If S <> "" Then SplitTextAddLine r, S
   
    MsgBox "A열에서 복사 완료"
End Sub

Sub SplitTextAddLine(r, S)
    Dim v, c As Long
    v = Split(S, vbLf)
    For c = 1 To UBound(v)
        r = r + 1
        Cells(r, 2) = v(c)
    Next
    S = ""
End Sub