在斜体string周围插入标签

我是VBA的新手，并试图编写一个在Excel中以斜体文本forms插入XML标签的脚本。 我发现这个问题： VBA Excel更改斜体并添加</和/>

第一个答案有一个聪明的办法，我正在修改该代码。 它的工作方式与单元格中第一个斜体string相同，但不适用于后续string。

这是我正在尝试的代码。 它遍历每个字符，直到find第一个斜体并插入一个标记并将lngCountvariables变为True。 当它find常规文本时，如果lngCountvariables为True，它将插入结束标记并将该variables重置为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循环或类似的方法，这样您就可以“跟上”由添加标签引起的长度变化。

编辑 ：在光testing这为我工作

 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