Question

我是VBA的新手，并尝试编写一个脚本，在Excel中的斜体文本周围插入XML标签。我发现了这个问题：VBA Excel Changing Italics and adding </ and />

第一个答案有一个聪明的方法，我正在修改该代码。它适用于单元格中第一个斜体字符串，但不适用于后续字符串。

这是我正在尝试的代码。它循环遍历每个字符，直到找到第一个斜体并插入标记并将lngCount变量转换为True。当找到常规文本时，如果lngCount变量为True，则插入结束标记并将变量重置为False。

它在某些单元格中运行良好，但在其他地方它不会插入结束标记，而在其他地方它不会插入任何标记。既然我无法找出任何一致的差异，当它运作良好但没有，有人可以帮忙吗？我误解了关于vba的任何事情吗？

Sub EmphTags()
    Dim lngStart As Long
    Dim lngFinish As Long
    Dim n As Long
    Dim rngCell As Range
    Dim rngConstants As Range

    On Error Resume Next
    Set rngConstants = ActiveSheet.UsedRange.SpecialCells(xlCellTypeConstants)
    On Error GoTo 0

    If Not rngConstants Is Nothing Then
        'Application.ScreenUpdating = False
        For Each rngCell In rngConstants.Cells
            lngCount = False
            lngStart = 0
            lngFinish = 0
            For n = 1 To Len(rngCell.Text)
                If rngCell.Characters(n, 1).Font.Color = 0 Then
                    If rngCell.Characters(n, 1).Font.Italic Then
                        If lngCount = False Then
                            lngStart = n
                            rngCell.Characters(lngStart, 0).Insert "<emph render='italic'>"
                            rngCell.Characters(lngStart, 22).Font.Italic = True
                        End If
                        lngCount = True
                    ElseIf lngCount = True Then
                        lngFinish = n
                        rngCell.Characters(lngFinish, 0).Insert "</emph>"
                        rngCell.Characters(lngFinish, 7).Font.Italic = False
                        lngCount = 0
                    End If
                End If
            Next n
        Next rngCell
        'Application.ScreenUpdating = True
    End If
End Sub

Answer 1

在你的循环中：

For n = 1 To Len(rngCell.Text)

Len(rngCell.Text)仅评估一次（当您第一次进入循环时）。使用For...Next循环或类似内容代替Do While，这样您就可以“跟上”添加标记所导致的长度变化。

编辑：在轻度测试中，这对我有用

Sub EmphTags()

    Const TAG_EMPH_START As String = "<emph render='italic'>"
    Const TAG_EMPH_END As String = "</emph>"

    Dim lngStart As Long
    Dim n As Long
    Dim rngCell As Range
    Dim rngConstants As Range
    Dim isItalic As Boolean

    On Error Resume Next
    Set rngConstants = ActiveSheet.UsedRange.SpecialCells(xlCellTypeConstants)
    On Error GoTo 0

    If Not rngConstants Is Nothing Then

        For Each rngCell In rngConstants.Cells

            lngStart = 0
            n = 1

            Do While n <= Len(rngCell.Text)

                If rngCell.Characters(n, 1).Font.Color = 0 Then

                    isItalic = rngCell.Characters(n, 1).Font.Italic

                    If isItalic And lngStart = 0 Then lngStart = n

                    If Not isItalic And lngStart > 0 Then
                        TagText rngCell, lngStart, n, TAG_EMPH_START, TAG_EMPH_END
                    End If

                End If
                n = n + 1
            Loop

            'deal with cases where terminal character(s) are italic
            If lngStart > 0 Then
                TagText rngCell, lngStart, n, TAG_EMPH_START, TAG_EMPH_END
            End If

        Next rngCell

    End If
End Sub

Sub TagText(rngCell As Range, ByRef lngStart As Long, ByRef lngEnd As Long, _
              tagStart As String, tagEnd As String)

    rngCell.Characters(lngStart, 0).Insert tagStart
    rngCell.Characters(lngEnd + Len(tagStart), 0).Insert tagEnd
    lngEnd = lngEnd + Len(tagStart) + Len(tagEnd)
    lngStart = 0

End Sub

在斜体字符串周围插入标签

1 个答案: