如何在表格单元格中迭代字符

Question

我试图迭代表单元格中的所有字符，但性能非常慢。也许是因为使用字符是昂贵的。

   For Each oRow In t.Rows
      ' Loop through each cell in the current row.
      For Each oCell In oRow.Cells
         ' If there is no background color in the cell, not worth to check
         If oCell.Shading.BackgroundPatternColorIndex = wdAuto Or oCell.Shading.BackgroundPatternColorIndex = wdWhite Then

            For i = 1 To oCell.Range.Characters.Count
                If oCell.Range.Characters(i).HighlightColorIndex = wdAuto Then
                    oCell.Range.Characters(i).HighlightColorIndex = wdPink
                End If
            Next
         End If
      Next oCell
   Next oRow

是否有更有效的方法来迭代单元格范围?

Answer 1

这种方法在我的测试中要快一些(大约2-3倍，取决于突出显示多少个字符):

Sub Tester()
    Dim t As Table, oRow, oCell, tm, n, rng As Range
    Dim sh, i As Long
    Set t = ThisDocument.Tables(1)
    tm = Timer
    For Each oRow In t.Rows
        For Each oCell In oRow.Cells
             sh = oCell.Shading.BackgroundPatternColorIndex
             If sh = wdAuto Or sh = wdWhite Then
                Set rng = oCell.Range
                n = Len(rng.Text)
                rng.Collapse wdCollapseStart
                For i = 1 To n
                    rng.MoveEnd wdCharacter, 1
                    If rng.HighlightColorIndex = wdAuto Then
                        rng.HighlightColorIndex = wdPink
                    End If
                    rng.Move wdCharacter, 1
                Next
             End If
        Next oCell
    Next oRow
    Debug.Print Timer - tm
End Sub