Hoe tekst te zoeken en vervangen terwijl u de opmaak in Excel behoudt?

De functie Zoeken en Vervangen is krachtig en nuttig wanneer we een specifieke waarde moeten vinden en deze door een andere moeten vervangen. Maar als er een bereik aan cellen is, en sommige van de cellen verschillende opmaakwaarden bevatten, zal het gebruik van de functie Zoeken en Vervangen om waarden te vinden en te vervangen de opmaak van de waarden in de cellen beschadigen zoals in onderstaande schermafbeelding te zien is. Hoe kunnen we de opmaak van waarden in elke cel behouden tijdens het zoeken en vervangen in Excel?

Zoeken en vervangen met behoud van opmaak met macrocode

Zoeken en vervangen met behoud van opmaak met macrocode

Er zijn geen andere methoden dan macrocode die u kan helpen bij het zoeken en vervangen van tekst terwijl de opmaak behouden blijft.

1. Druk op Alt + F11 om het Microsoft Visual Basic for Application-venster te openen.

2. Klik op Invoegen > Module, en plak de volgende code in het script.

VBA: Zoeken en vervangen met behoud van opmaak

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, "KK", "Kutools", True)
End Sub

Tip: In de code is KK de tekst die u wilt zoeken, en Kutools is de tekst waarmee u wilt vervangen. U kunt deze naar wens wijzigen.

3. Druk op F5 toets, er verschijnt een dialoogvenster waarin u een bereik kunt selecteren om te zoeken en te vervangen, zie onderstaande schermafbeelding:

4. Klik op OK, en de specifieke tekst in de geselecteerde cellen wordt vervangen door een andere tekst terwijl de opmaak behouden blijft.