excel - 无法从 VBA 中的事件单元格中删除字符

Question

我有一个 Excel 2013 工作表，其中包含一些 HTML 格式的数据(特别是下标和上标)。我正在尝试适本地重新格式化数据。当我循环遍历每个单元格时，我运行一个宏来格式化 HTML 并删除标签。对于第一个单元格，它工作得很好。对于第二个单元格，我收到此错误:“”

对正在发生的事情有什么想法吗？

“这个单元格工作得很好 - 它将 o 字符转换为上标并去掉标签

10) Using the above graphic, what is the temperature at point A?
A. 2<sup>o</sup> C
B. 4<sup>o</sup> C
C. 5<sup>o</sup> C
D. 7<sup>o</sup> C

'此单元格抛出异常

43) Which is true for all Mesothermal (C) climates?
A. The wamest month is between 10 and 18<sup>o</sup>C
B. The warmest month is greater than 10<sup>o</sup>C and the coldest month is between 0 and 10<sup>o</sup>C
C. The coldest month is below 0<sup>o</sup>C
D. All of the above

宏代码如下:

Sub FormatHTML(inval As Variant)
    Dim outval As String
    Dim isSup As Boolean
    Dim isSub As Boolean
    Dim start As Integer
    Dim start2 As Integer

    isSup = InStr(ActiveCell.Value, "<sup>") > 0
    isSub = InStr(ActiveCell.Value, "<sub>") > 0

    Do Until isSup = False And isSub = False
        If isSup Then
            start = InStr(ActiveCell.Value, "<sup>") + 5
            With ActiveCell.Characters(start:=start, Length:=1).Font
                .Superscript = True
            End With
            With ActiveCell.Characters(start:=(start - 5), Length:=5)
                .Delete
            End With
            start2 = InStr(ActiveCell.Value, "</sup>")
            With ActiveCell.Characters(start:=start2, Length:=6)
                .Delete
            End With
        End If
        If isSub Then
            start = InStr(ActiveCell.Value, "<sub>") + 5
            With ActiveCell.Characters(start:=start, Length:=1).Font
                .Subscript = True
            End With
            With ActiveCell.Characters(start:=(start - 5), Length:=5)
                .Delete
            End With
            start2 = InStr(ActiveCell.Value, "</sub>")
            With ActiveCell.Characters(start:=start2, Length:=6)
                .Delete
            End With
        End If
        isSup = InStr(ActiveCell.Value, "<sup>") > 0
        isSub = InStr(ActiveCell.Value, "<sub>") > 0
    Loop
End Sub

谢谢， 格伦

Answer 1

在不了解更多信息的情况下(例如，您会将其用于其他 HTML 标记，还是仅用于上标？)，以下内容将删除 <sup>o</sup>并替换为度数符号:

Sub test2()
    Dim lastRow As Integer
    Dim rng As Range, cel As Range

    lastRow = ActiveSheet.UsedRange.Rows.Count
    Set rng = Range(Cells(1, 1), Cells(lastRow, 1))

    rng.Replace What:="<sup>o</sup>", Replacement:="°", LookAt:=xlPart _
        , SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False

End Sub

您也可以使用 <sub> 执行相同的操作，只需复制 rng.Replace ...并使用<sub>而不是<sup> 。这是否有效，或者是否还有更多 HTML 需要删除等？

编辑:好的，问题是 .Characters.Delete不能用于超过 255 个字符的单元格。所以，我想做的是，如果单元格长度> 255，则分成两个单元格并一次处理一个单元格。这仍然需要调整，但我想我应该把我现在拥有的东西放在上面:

Sub FormatHTML()
Dim outval  As String
Dim isSup As Boolean, isSub As Boolean
Dim start As Integer, start2 As Integer, lastRow As Integer, i As Integer
Dim rng As Range, cel As Range

isSup = InStr(ActiveCell.Value, "<sup>") > 0
isSub = InStr(ActiveCell.Value, "<sub>") > 0

Set cel = ActiveCell

lastRow = ActiveSheet.UsedRange.Rows.Count
Set rng = Range(Cells(1, 1), Cells(lastRow, 2))

For Each cel In rng

    If Len(cel) > 255 Then
        cel.Offset(0, 1).Value = Right(cel.Value, Len(cel.Value) - 255)
        cel.Value = Left(cel.Value, 255)
        isSup = InStr(cel.Value, "<sup>") > 0
        isSub = InStr(cel.Value, "<sub>") > 0

    End If
    Do Until isSup = False And isSub = False
        If isSup Then
            start = InStr(cel.Value, "<sup>") + 5
            With cel.Characters(start:=start, Length:=1).Font
                .Superscript = True
            End With
            With cel.Characters(start:=(start - 5), Length:=5)
                .Delete
            End With
            start2 = InStr(cel.Value, "</sup>")
            With cel.Characters(start:=start2, Length:=6)
                .Delete
            End With
        End If
        If isSub Then
            start = InStr(cel.Value, "<sub>") + 5
            With cel.Characters(start:=start, Length:=1).Font
                .Subscript = True
            End With
            With cel.Characters(start:=(start - 5), Length:=5)
                .Delete
            End With
            start2 = InStr(cel.Value, "</sub>")
            With cel.Characters(start:=start2, Length:=6)
                .Delete
            End With
        End If
        isSup = InStr(cel.Value, "<sup>") > 0
        isSub = InStr(cel.Value, "<sub>") > 0
    Loop
Next cel

For i = 2 To lastRow
    If Not IsEmpty(Cells(i, 2)) Then
        Cells(i, 2).Offset(0, -1).Value = Cells(i, 2).Offset(0, -1).Value & Cells(i, 2).Value
    End If
Next i

End Sub

Edit2:一些注释。正如您从上面可以看出的，它将把 len > 255 的单元格分成两个单元格。然后它尝试将第二个单元格文本添加回 COl。答:但是，问题:当您将第二个单元格中的文本与第一个单元格中的文本组合时，度数符号将重置为 o而不是上标。

存在一些解决方法。一种是使用查找/替换(正如我放在顶部的那样)，并且当您有新的 HTML 元素要替换时，只需添加到此列表即可。或者，您可以对长度低于 255 的所有单元格运行子程序，并自行分离较大的单元格。 (请注意，到目前为止，如果末尾的长度> 255，代码会将 </sup> 拆分为 </su 和 p>...我将继续努力，看看是否有更好的解决方案。