VBA 从标记到粗体答案

【问题标题】：VBA from tag to boldVBA 从标记到粗体
【发布时间】：2016-10-27 20:11:56
【问题描述】：

在 Excel 中，我在几行中有不同的数据，其中包含这样的粗体标签：

bonjour, <b>je</b> voudrais <b>savoir</b> un truc

我需要将标签之间的文本转换为粗体，并去掉所有电子表格中的标签。这是我正在寻找的结果：

bonjour, je voudrais savoir un truc

自从我开始使用 VBA 以来，我已经从其他论坛获取了一些代码部分来尝试实现这一点，但它所能做的就是一次一行地进行转换。我希望这个宏可以在所有电子表格上运行。

你们知道如何完成吗？

这是代码：

Option Explicit
Sub testme01()

Dim str As String
Dim nBold() As Long
Dim nEndBold() As Long
Dim nChars() As Long
Dim nTimes As Long
Dim iCtr As Long

With ActiveCell
str = .Text
nTimes = (Len(str) - Len(Replace(str, "<b>", ""))) / Len("<b>")
If nTimes = 0 Then
'do nothing
Else
ReDim nBold(1 To nTimes)
ReDim nEndBold(1 To nTimes)
ReDim nChars(1 To nTimes)

For iCtr = 1 To nTimes
nBold(iCtr) = InStr(str, "<b>")
nEndBold(iCtr) = InStr(nBold(iCtr), str, "</b>")
If nEndBold(iCtr) = 0 Then
nEndBold(iCtr) = 32767
End If
nChars(iCtr) = nEndBold(iCtr) - nBold(iCtr) - 3
str = Replace(Replace(str, "<b>", "", 1, 1), "</b>", "", 1, 1)
Next iCtr

str = Replace(str, "</b>", "")
.Value = str

For iCtr = 1 To nTimes
.Characters(nBold(iCtr), nChars(iCtr)).Font.Bold = True
Next iCtr

End If
End With
End Sub

感谢:)

【问题讨论】：

我看到你正在使用循环。您是否尝试过将概念扩展到迭代行？另外，我建议您缩进您的代码 - 所有内容都粘在左侧，很难判断哪个循环/条件在哪里开始/结束。

标签： excel vba

【解决方案1】：

你有没有 Sub 接受一个 Range 变量作为它的参数（比如说它被称为 cell），然后在外部“Main”Sub 的循环中调用它

如下：

Option Explicit

Sub main()
    Dim cell As Range

    With Worksheets("bolds") '<--| change "bolds" to your actual worksheet name
        For Each cell In .UsedRange.SpecialCells(XlCellType.xlCellTypeConstants, xlTextValues)
            ProcessBolds cell
        Next cell
    End With
End Sub

Sub ProcessBolds(cell As Range)
    Dim str As String
    Dim nBold() As Long
    Dim nEndBold() As Long
    Dim nChars() As Long
    Dim nTimes As Long
    Dim iCtr As Long

    With cell
        str = .Text
        nTimes = (Len(str) - Len(Replace(str, "<b>", ""))) / Len("<b>")
        If nTimes = 0 Then
            'do nothing
        Else
            ReDim nBold(1 To nTimes)
            ReDim nEndBold(1 To nTimes)
            ReDim nChars(1 To nTimes)

            For iCtr = 1 To nTimes
                nBold(iCtr) = InStr(str, "<b>")
                nEndBold(iCtr) = InStr(nBold(iCtr), str, "</b>")
                If nEndBold(iCtr) = 0 Then
                    nEndBold(iCtr) = 32767
                End If
                nChars(iCtr) = nEndBold(iCtr) - nBold(iCtr) - 3
                str = Replace(Replace(str, "<b>", "", 1, 1), "</b>", "", 1, 1)
            Next iCtr

            str = Replace(str, "</b>", "")
            .Value = str

            For iCtr = 1 To nTimes
                .Characters(nBold(iCtr), nChars(iCtr)).Font.Bold = True
            Next iCtr
        End If
    End With
End Sub

【讨论】：