テキストファイルにA列,B列の値を書きだしてみたテスト

ドラマの台詞をExcelに A列,B列打ちこんだので(今週分は打ちこんでいないけど)
下記のVBAで出力してみた。

条件は、
A列サブタイトルか役名、空白もあり
B列台詞

適当にタグをつけて書き込んでみた。

Option Explicit


'シートからテーブルを作る
'単純にテキストファイルに書き出してみた
'1.A列のみにデータが存在する場合、見出しのH3にする
'2.B列の強調文字 .Font.Bold = True なら Bタグで囲う
'3.A列、B列何もなければ、処理しない
'4.1000行目までデータをチェックする(今回は固定)

Sub TABLE作成()

    Dim y As Integer  '行カウンター
   
    Dim strWORK As String  'HTML文をため込む 文字変数
    
    Dim strA As String 'A列のデータ
    Dim strB As String 'B列のデータ
    
    Dim n As Integer   'H3 見出しの数
    
    Open ActiveWorkbook.Path & "\テーブル.txt" For Output As #1
    
    n = 0
    For y = 3 To 999 '三行目から９９９行目までループする
        'AとB列の文字を取り出す、Trimで整形
        strA = Trim("" & Cells(y, "A"))
        strB = Trim("" & Cells(y, "B"))
        'どちらか に データが入っていたら処理を行う
        If strA <> "" Or strB <> "" Then
            If strB = "" Then  'B列にデータ無し(見出しか？チェック)
                'A列のみデータアリの時、シーンを区切る
                Print #1, strWORK   'データをファイルへ書き出す
                strWORK = "" 'ワークをクリア
                
                Print #1, "</table><br><br>"
                Print #1, ""
                Print #1, ""
                '見出しを書き込む
                n = n + 1
                Print #1, "<h3>美しい隣人 第８話 " & Format(n, "00") & " " & strA & "</h3>"
                Print #1, ""
                Print #1, "<table border=0 cellpadding=4>"  '会話のテーブルを開始する
                
            Else  'B列にデータアリ 会話、その他 の時、1行メモリに保存
                If Cells(y, "B").Font.Bold = True Then '強調文字のチェック
                    strWORK = strWORK & "<tr><td>" & strA & "</td><td><b>" & strB & "</b></td></tr>" & vbCrLf
                Else
                    strWORK = strWORK & "<tr><td>" & strA & "</td><td>" & strB & "</td></tr>" & vbCrLf
                End If
            End If
        End If
        
    Next y
    
    '終了処理
    Print #1, strWORK   '最後のデータを書き出す。
    Print #1, "</table><hr><br><br>"
    Print #1, ""

    Close #1  'ファイルを忘れずに閉じる

    MsgBox "終了しました、テキストファイルを確認してください"

End Sub