简体   繁体   中英

How to find and replace part of a cell with formatted text

In an Excel 2007 spreadsheet I want to find-replace with highlighting part of the text in a cell. Using find-replace reformats the entire cell though.

For example, if the cell contains:

Pellentesque vel massa sit amet magna eleifend placerat. Pellentesque dictum, nibh vitae tincidunt placerat, elit libero tristique tellus, vel imperdiet nulla tortor id diam. Mauris porta blandit vestibulum.

I want to find "Pellentesque" and replace it with .

Can this be done without VBE or formulas?

Maybe this would suit (be sure to select no more cells than necessary before running or this could take a while):

Sub FormatSelection()

Dim cl As Range
Dim SearchText As String
Dim StartPos As Integer
Dim EndPos As Integer
Dim TestPos As Integer
Dim TotalLen As Integer

On Error Resume Next
Application.DisplayAlerts = False
SearchText = Application.InputBox _
(Prompt:="Enter string.", Title:="Which string to format?", Type:=2)
On Error GoTo 0
Application.DisplayAlerts = True
If SearchText = "" Then
Exit Sub
Else
For Each cl In Selection
  TotalLen = Len(SearchText)
  StartPos = InStr(cl, SearchText)
  TestPos = 0
  Do While StartPos > TestPos
    With cl.Characters(StartPos, TotalLen).Font
      .FontStyle = "Bold"
      .ColorIndex = 3
    End With
    EndPos = StartPos + TotalLen
    TestPos = TestPos + EndPos
    StartPos = InStr(TestPos, cl, SearchText, vbTextCompare)
  Loop
Next cl
End If
End Sub

Should embolden and colour Red. Changes are not overwritten if macro is rerun. Comment out .ColorIndex = 3 if not to change colour.

(Based on @Skip Intro's pointer to SO15438731 question with amendment and some code from SO10455366 answer.)

This is what worked great for me:

  1. Selected cells in Excel (I selected 1266 at a time--don't know if there's really any limit)

  2. Clicked on COPY

  3. Opened a blank word file and clicked on PASTE

  4. Used CNTL+H to get Find & Replace

  5. Entered the characters to find and the characters to replace, adding any formatting desired and selected Replace All (the process took less than 2 seconds)

  6. Selected Edit-Select-Select All in the Word file, then held the shift key and pressed the left arrow (I think not doing this would add a row to the next operation)

  7. Went back into Excel and, in a spare area, selected Paste - Keep Source Formatting option

That put exactly what I wanted into Excel. From there I could move it wherever I wanted it.

The absolute EASIEST WAY to do this with the standard Find & Replace CTRL+F Command is to just "temporary" add-in the "Calibri Font" Character • aka. "black bullet dot"

like this: • sample •

from the Insert Tab --> Symbols --> Calibri Font --> and at the very end)

Thus you can make it much easier to the eyes to read over many rows of excel data,

and easily also later remove it back again to the original with simply again a Find & Replace reversed.

Hope this helps someone, it sure helped my eyes to scan over quicker.


OLD RESPONSE

the easy non-programming way to do this, is to:

  1. paste the text into MS Word

  2. Then run the Find & Replace (CTRL+F) there (with the custom formatting changes at the bottom left button under "More > >" and then "Format" to your need customized) - which will then do all the changes perfectly...

  3. and then rather than doing a PASTE SPECIAL into Excel (via the Home Tab --> Paste --> Paste Special --> Paste as HTML (so to retain the formatting) (which can and is too memory intensive and too slow for anything above like 1000 rows)

it is better to simply "Save as" from Word the document into a RTF-File, and then just re-import that file into Excel via the simple "Open File".

Excel has a pretty good "repeating pattern cell structuring" recognition, but of course, this workaround may not work perfectly in reproducing the desired cell division every single time, but it should maintain the cell order nevertheless most of the time.

So much for the simple way to do it, until Microsoft stops limiting an option to "highlight/bold" a found-result-text WITHIN a cell, rather than always bolding the entire cell.

Greetings Marko

To make the search item case agnostic you can use:

Sub FormatSelection()

Dim cl As Range
Dim SearchText As String
Dim StartPos As Integer
Dim EndPos As Integer
Dim TestPos As Integer
Dim TotalLen As Integer

On Error Resume Next
Application.DisplayAlerts = False
SearchText = Application.InputBox _
(Prompt:="Enter string.", Title:="Which string to format?", Type:=2)
On Error GoTo 0
Application.DisplayAlerts = True
If SearchText = "" Then
Exit Sub
Else
For Each cl In Selection
  TotalLen = Len(SearchText)
  StartPos = InStr(Ucase(cl), Ucase(SearchText))
  TestPos = 0
  Do While StartPos > TestPos
    With cl.Characters(StartPos, TotalLen).Font
      .FontStyle = "Bold"
      .ColorIndex = 3
    End With
    EndPos = StartPos + TotalLen
    TestPos = TestPos + EndPos
    StartPos = InStr(TestPos, cl, SearchText, vbTextCompare)
  Loop
Next cl
End If
End Sub

The code of @pnuts has a small bug... The fixed version:

Sub FormatSelection()

Dim cl As Range
Dim SearchText As String
Dim StartPos As Integer
Dim EndPos As Integer
Dim TestPos As Integer
Dim TotalLen As Integer

On Error Resume Next
Application.DisplayAlerts = False
SearchText = Application.InputBox _
(Prompt:="Enter string.", Title:="Which string to format?", Type:=2)
On Error GoTo 0
Application.DisplayAlerts = True
If SearchText = "" Then
Exit Sub
Else
For Each cl In Selection
  TotalLen = Len(SearchText)
  StartPos = InStr(cl.Value2, SearchText)
  TestPos = 0
  Do While StartPos > TestPos
    With cl.Characters(StartPos, TotalLen).Font
      .FontStyle = "Bold"
      .ColorIndex = 3
    End With
    EndPos = StartPos + TotalLen
    TestPos = EndPos + 1
    StartPos = InStr(TestPos, cl.Value2, SearchText)
  Loop
Next cl
End If
End Sub

Practically the issue is with this line TestPos = EndPos + 1 - Previously TestPos = TestPos + EndPos

The technical post webpages of this site follow the CC BY-SA 4.0 protocol. If you need to reprint, please indicate the site URL or the original address.Any question please contact:yoyou2525@163.com.

 
粤ICP备18138465号  © 2020-2024 STACKOOM.COM