用于添加HTML标记的Excel VBA

Question

我有下面的代码，用于为单元格追加文本。但是它并没有附加HTML标记。

例如：

9/23/99 10:37我们不去了。我身体不好。哥伦布不是一个繁荣的地方。大多是退役军人。她打电话来问为什么她是唯一的一个。也想要她的搭档。我解释说在会议上会发生这种事。9/10/99 4:15 P Rick提到995美元想要埃塞克斯基金公司WY 4262-3607-0011-9582 8/01 8/23/99 9:08am想要一家NV公司。需要做一点财政上的改变。几个节目。穆和导师。帕特斯和我.我60岁了。我昨天把牌用完了。

应该就像

"HTML段落标签“9/23/99 10:37我们不去。我身体不好。哥伦布不是一个繁荣的地方。大多是退役军人。她打电话来问为什么她是唯一的一个。也想要她的搭档。我解释说在会议上会发生这种事。“结束HTML段落标签”"HTML段落标签“9/10/99无需担心

下面是我得到的代码

Option Explicit

Sub main()
    Dim newStrng As String
    Dim word As Variant
    Dim strngToBeAppended As String

    strngToBeAppended = Application.InputBox("Input string to be appended", 1)

    With Worksheets("TextSheet") '<-- change "TextSheet" to your actual sheet with text name
        For Each word In Split(.Range("A1").Text, " ") '<-- assuming that the text to be splitted is in cell "A1" of the referenced worksheet
            If Len(word) - Len(Replace(word, "/", "")) = 2 Then
                newStrng = newStrng & " " & strngToBeAppended & word
            Else
                newStrng = newStrng & " " & word
            End If
        Next word
        .Range("A2").Value = LTrim(newStrng)
    End With
End Sub

Answer 1

试试这个：

Option Explicit

Sub main()
    Dim newStrng As String
    Dim word As Variant
    Dim parTag As String, endParTag As String
    Dim dateCounter As Long

    parTag = "<p>" '<-- change this to whatever your "HTML Paragraph Tag" may be
    endParTag = "</p>" '<-- change this to whatever your "End of HTML Paragraph Tag" may be
    With Worksheets("TextSheet") '<-- change "TextSheet" to your actual sheet with text name
        For Each word In Split(.Range("A1").Text, " ") '<-- assuming that the text to be splitted is in cell "A1" of the referenced worksheet
            If Len(word) - Len(Replace(word, "/", "")) = 2 Then
                dateCounter = dateCounter + 1
                If dateCounter > 1 Then newStrng = newStrng & endParTag
                newStrng = newStrng & parTag & word
            Else
                newStrng = newStrng & " " & word
            End If
        Next word
        If dateCounter > 1 Then newStrng = newStrng & endParTag
        .Range("A2").Value = LTrim(newStrng)
    End With
End Sub