Question

在Excel中，我在包含粗体标记的多行中有不同的数据，如下所示：

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

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

bonjour， je voudrais savoir un truc

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

你们有没有想过如何完成这项工作？

Heres是代码：

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

Thanx：）

Answer 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

VBA从标签到粗体

1 个答案: