Question

我有一个excel文件，需要查找并替换，并且单元格已经格式化。我需要保留格式。当我在excel中进行普通查找和替换时，这会删除格式。我需要帮助以保留格式。我在网上搜索并找到了以下链接，但该代码对我不起作用。

当我尝试以下代码时，该行在代码中为红色。

Call CharactersReplace(xRg, "<span style="background-color: #ffff00;">KK</span>", "<span style="background-color: #ffff00;">Kutools</span>", True)

我需要帮助来更正此代码并使它起作用。或者，如果有更简便的方法，请告诉我。

https://www.extendoffice.com/documents/excel/3760-excel-find-and-replace-preserve-formatting.html

Sub CharactersReplace(Rng As Range, FindText As String, ReplaceText As String, Optional MatchCase As Boolean = False)
  'UpdatebyExtendoffice20160711
    Dim I As Long
    Dim xLenFind As Long
    Dim xLenRep As Long
    Dim K As Long
    Dim xValue As String
    Dim M As Long
    Dim xCell As Range
    xLenFind = Len(FindText)
    xLenRep = Len(ReplaceText)
    If Not MatchCase Then M = 1
    For Each xCell In Rng
        If VarType(xCell) = vbString Then
            xValue = xCell.Value
            K = 0
            For I = 1 To Len(xValue)
              If StrComp(Mid$(xValue, I, xLenFind), FindText, M) = 0 Then
                xCell.Characters(I + K, xLenFind).Insert ReplaceText
                K = K + xLenRep - xLenFind
              End If
            Next
        End If
    Next
End Sub

Sub Test_CharactersReplace()
    Dim xRg As Range
    Dim xTxt As String
    Dim xCell As Range
    On Error Resume Next
    If ActiveWindow.RangeSelection.Count > 1 Then
      xTxt = ActiveWindow.RangeSelection.AddressLocal
    Else
      xTxt = ActiveSheet.UsedRange.AddressLocal
    End If
    Set xRg = Application.InputBox("Select a range:", "Kutools for Excel", xTxt, , , , , 8)
    If xRg Is Nothing Then Exit Sub
    Call CharactersReplace(xRg, "<span style="background-color: #ffff00;">KK</span>", "<span style="background-color: #ffff00;">Kutools</span>", True)
End Sub

Answer 1

我很感谢我从@Marc的评论中学到的东西，但是在尝试编辑xml之后，我发现它太复杂了。我犯的任何小错误都使xml文件无法通过Excel打开。

因此，我的解决方案是使用Word的高级查找和替换功能将工作表复制到Word（作为Word表出现），然后将表粘贴回Excel工作表中。它对我有用。

因为我想做很多工作，所以制作了这个VBA例程。将我的数据（在前两列中）复制到Word中后，它会删除所有上标字符，并进行一些我需要的格式化。虽然不漂亮，但它为我完成了72张纸，节省了大量繁琐的工作。

Sub ExcelSheetsEditedViaWord()
' note: must add a reference to the Word-library (Microsoft Word 16.0 Object Lilbrary)
Dim wrdApp As Word.Application
Dim wrdDoc As Word.Document
Dim s As String, i As Integer, sh As Worksheet, r As Range
  Application.DisplayStatusBar = True
  Application.StatusBar = "Opening Word  ..."
  Set wrdApp = CreateObject("Word.Application")
  wrdApp.Visible = True
  Set wrdDoc = wrdApp.Documents.Add
  With ActiveDocument.PageSetup
    .PageWidth = InchesToPoints(11)
    .PageHeight = InchesToPoints(22)
  End With
  wrdApp.ActiveWindow.ActivePane.View.Zoom.Percentage = 40
  i = 0
  For Each sh In ThisWorkbook.Worksheets
    Set r = sh.Range("A1:B1")
    Set r = sh.Range(r, r.End(xlDown))
    r.Copy
    'wait to avoid error that sometimes stops code.
    Application.Wait (Now + TimeValue("0:00:01"))
    wrdDoc.Range.PasteExcelTable False, False, False
    sh.Activate
    sh.Range("A1").Select
    With wrdApp.Selection
      .Find.ClearFormatting
      With .Find.Font
        .Superscript = True
        .Subscript = False
      End With
    .Find.Replacement.ClearFormatting
      With .Find
        .Text = ""
        .Replacement.Text = ""
        .Forward = True
        .Wrap = wdFindContinue
      End With
    .Find.Execute Replace:=wdReplaceAll
    .WholeStory
    .Cut
    'wait some second to try to avoid error that stops code. However,
    'even when code stops, hitting debug allows it to continue
    Application.Wait (Now + TimeValue("0:00:06"))
    sh.Paste
    With sh.Columns("A:B")
      .VerticalAlignment = xlTop
      .WrapText = True
      .Font.Name = "Times New Roman"
      .Font.Size = 16
    End With
    i = i + 1
    End With
    Application.StatusBar = i & " sheets done"
  Next sh
  wrdApp.Quit False ' close the Word application
  Set wrdDoc = Nothing
  Set wrdApp = Nothing
  MsgBox i & " sheets of the workbook processed"
End Sub

我有一些Application.Wait()语句，其中的代码有时会失败—我在使用Excel和Word之间复制/粘贴的代码中看到了很多东西。但是，如果失败，则每次单击“调试”并继续即可。如我所说，虽然不漂亮，但可以完成工作。

查找和替换文本，保留格式

1 个答案: