Excel宏VBA使用HTML标记粗体斜体在单元格中加下划线

我一直在寻找转换字符串或单元格的方法，例如：

[单元B2示例]

“这是一个充满随机放置的html标记的测试单元”

[需要的输出示例]“这是一个测试单元格，填充了随机放置的html标记”

我需要能够在同一单元格或字符串中处理多种类型的标记（

，，

）

到目前为止，有人帮助我走到了这一步：

    Dim Tag, Tend, Pstart, Pend As String
    
    'BOLD Text
    Tag = "<b>"       ' tag string: start
    Tend = "</b>"      ' tag string: end
    Pstart = 0          ' vector index of Pos()
    Pend = 1          ' vector index of Pos()
    
    Dim Cv          As String               ' Cell value
    Dim Cnt         As Integer              ' instances of bold expressions
    Dim Pos()       As Variant              ' string positions: 0 = start, 1 = End
    Dim f           As Integer              ' loop counter: Cnt
    
    Cv = Range("B2").Value
    Cnt = (Len(Cv) - Len(Replace(Cv, Tag, ""))) / 3
    ReDim Pos(Cnt, Pend)
    For f = 1 To Cnt
        Pos(f, Pstart) = InStr(Cv, Tag)
        Cv = Left(Cv, Pos(f, Pstart) - 1) & Mid(Cv, Pos(f, Pstart) + Len(Tag), Len(Cv))
        Pos(f, Pend) = InStr(Cv, Tend) - 1
        Cv = Left(Cv, Pos(f, Pend)) & Mid(Cv, Pos(f, Pend) + Len(Tend) + 1, Len(Cv))
    Next f
    
    With Range("B2")
        .Font.Bold = False
        .Value = Cv
        For f = 1 To Cnt
            .Characters(Pos(f, Pstart), Pos(f, Pend) - Pos(f, Pstart) + 1).Font.Bold = True
        Next f
    End With

Dim标记、Tend、Pstart、Pend作为字符串
"黑体字"
Tag=“”标记字符串：开始
Tend=“”标记字符串：结束
Pstart=0'Pos（）的向量索引
Pend=1'Pos（）的向量索引
将Cv设置为字符串的单元格值
Dim Cnt作为粗体表达式的整数实例
Dim Pos（）作为变量的字符串位置：0=开始，1=结束
Dim f作为“整数”循环计数器：Cnt
Cv=范围（“B2”）.值
Cnt=（Len（Cv）-Len（替换（Cv，标记“”））/3
ReDim Pos（Cnt、Pend）
对于f=1到Cnt
位置（f，Pstart）=仪表（Cv，标签）
Cv=左（Cv，位置（f，Pstart）-1）和中（Cv，位置（f，Pstart）+镜头（标签），镜头（Cv））
位置（f，悬挂）=仪表（Cv，倾向）-1
Cv=左（Cv，位置（f，Pend））和中（Cv，位置（f，Pend）+长（Tend）+1，长（Cv））
下一个f
带范围（“B2”）
.Font.Bold=False
.Value=Cv
对于f=1到Cnt
.字符（Pos（f，Pstart），Pos（f，Pend）-Pos（f，Pstart）+1。Font.Bold=True
下一个f
以

上述操作成功地将所需文本变为粗体，并从单元格中删除可视标记。 然而，当尝试同时合并斜体、下划线和强标记时，它只会合并最后一个。其余的都被消灭了

有更好的方法吗？ 是否可以将多个html标记转换为excel字符串或单元格，而无需打开其他应用程序，如IE等

---

旁注，对于标记，如果它们的功能与粗体相同就可以了，这样会更简单吗？

一旦您分配单元格的.Value属性，任何每字符字体格式都将丢失，因此您不能在格式化过程中这样做

这里有一种方法可以做到这一点-不防弹，也不会解释（例如）相同标记或无效HTML的嵌套集

Sub Tester()
    Dim c As Range
    
    Set c = ActiveSheet.Range("D5")
    ActiveSheet.Range("D2").Copy c 'for testing:copy the input string
    
    FormatTags c, "b", "bold"
    FormatTags c, "i", "italic"
    FormatTags c, "strong", "bold"
    FormatTags c, "u", "underline"
    
End Sub

Sub FormatTags(c As Range, tag As String, prop As String)
    Dim pOpen As Long, pClose As Long, numChars As Long
    Dim sOpen, sClose
    sOpen = "<" & tag & ">"        'the open tag
    sClose = "</" & tag & ">"      'close tag
    pOpen = InStr(c.Value, sOpen)  'have an open tag?
    Do While pOpen > 0
        pClose = InStr(pOpen + 1, c.Value, sClose)  'find next close tag
        If pClose > 0 Then
            c.Characters(pClose, Len(sClose)).Delete 'remove the close tag first
            c.Characters(pOpen, Len(sOpen)).Delete   'remove the open tag
            'set the named font property
            numChars = pClose - (pOpen + Len(sOpen))
            CallByName c.Characters(pOpen, numChars).Font, prop, VbLet, True
            pOpen = InStr(c.Value, sOpen) 'find next, if any
        Else
            Exit Do 'no closing tag - all done
        End If
    Loop
End Sub

---

行

ActiveSheet.Range（“D2”）.Copy c

为我提供了一个错误“无法对合并单元格执行此操作”。-删除这一行后，脚本会将一个标记的一部分加粗到一半，并无限期冻结Excel。很抱歉我不知道……

Tester

只是一个如何使用

FormatTags

的示例-您可以重写该部分以符合您的布局/需要

With ActiveSheet
    myClipboard.SetClipboardText .Range("D5").value, "HTML Format"
    .Paste Destination:=.Range("D5")
End With