Excel'de metni bulup değiştirirken biçimlendirmeyi nasıl koruyabiliriz?

Bul ve Değiştir fonksiyonu, belirli bir değeri bulup başka bir değerle değiştirmek istediğimizde güçlü ve kullanışlıdır. Ancak, eğer bir hücre aralığı varsa ve bu hücrelerden bazıları farklı biçimlendirme değerleri içeriyorsa, bu durumda Bul ve Değiştir fonksiyonunu kullanarak değeri bulup değiştirmek, aşağıdaki ekran görüntüsünde gösterildiği gibi hücrelerdeki değerlerin biçimlendirmesini bozacaktır. Excel'de bulup değiştirirken her hücredeki değerlerin biçimlendirmesini nasıl koruyabiliriz?

Makro kodu ile biçimlendirmeyi koruyarak bul ve değiştir

Makro kodu ile biçimlendirmeyi koruyarak bul ve değiştir

Metni bulup değiştirip biçimlendirmeyi korumak için makro kodundan başka bir yöntem yoktur.

1. Microsoft Visual Basic for Applications penceresini açmak için Alt + F11 tuşlarına basın.

2. Ekle > Modül'e tıklayın ve aşağıdaki kodu betiğe yapıştırın.

VBA: Biçimlendirmeyi koruyarak bul ve değiştir

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

İpucu: Kodda, KK bulmak istediğiniz metindir ve Kutools ise değiştirmek istediğiniz metindir, bunları ihtiyaçlarınıza göre değiştirebilirsiniz.

3. Tuşa basın F5 tuşuna bastığınızda, bir iletişim kutusu açılacak ve bulup değiştirmek için bir aralık seçmenizi sağlayacaktır, aşağıdaki ekran görüntüsüne bakın:

4. Tamam'a tıklayın ve seçilen hücrelerdeki belirli metin diğer metinle değiştirilecek ve biçimlendirme korunacaktır.