在excel中必须在单元格中搜索特定字符串并将样式应用于该特定字符串

时间:2012-03-15 09:30:56

标签: excel excel-vba vba

在excel中,我必须在单元格中搜索特定单词,并仅替换特定单词。

例如: 在excel中,单元格可能包含

  

“团队应该已将测试数据加载到文件”

我想在此行中只选择一个单词,例如test,并将样式应用于该特定字符串

  

“团队应该已将测试数据加载到文件”

我有很多要格式化的单元格,所以我想使用VBA

2 个答案:

答案 0 :(得分:3)

这样的事情会将用户选择范围内所有单元格中的“test”更改为粗体。它处理单个单元格中的多次出现

测试不区分大小写

Option Explicit

Const strText As String = "test"

Sub ColSearch_DelRows()
Dim rng1 As Range
Dim rng2 As Range
Dim cel1 As Range
Dim cel2 As Range
Dim strFirstAddress As String
Dim lAppCalc As Long
Dim objRegex As Object
Dim RegMC As Object
Dim RegM As Object

Set objRegex = CreateObject("vbscript.regexp")

With objRegex
    .Global = True
    .Pattern = strText
End With

'Get working range from user
On Error Resume Next
Set rng1 = Application.InputBox("Please select range to search for " & strText, "User range selection", Selection.Address(0, 0), , , , , 8)
On Error GoTo 0
If rng1 Is Nothing Then Exit Sub

With Application
    lAppCalc = .Calculation
    .ScreenUpdating = False
    .Calculation = xlCalculationManual
End With

Set cel1 = rng1.Find(strText, , xlValues, xlPart, xlByRows, , False)
If Not cel1 Is Nothing Then
    Set rng2 = cel1
    strFirstAddress = cel1.Address
    Do
        Set cel1 = rng1.FindNext(cel1)
        Set rng2 = Union(rng2, cel1)
    Loop While strFirstAddress <> cel1.Address
End If

If Not rng2 Is Nothing Then
    For Each cel2 In rng2
        Set RegMC = objRegex.Execute(cel2.Value)
        For Each RegM In RegMC
            cel2.Characters(RegM.firstindex, RegM.Length + 1).Font.Bold = True
        Next
    Next
End If

With Application
    .ScreenUpdating = True
    .Calculation = lAppCalc
End With

End Sub

答案 1 :(得分:2)

以下是一个片段,向您展示如何格式化单元格中的一段文字:

Sub EditFont()
'To format font color for 12 digits to 4 black, 5 red, 3 black:

' Here is some sample text to try it on: 123456789012

'First, format digits to be treated as characters
ActiveCell.Value = "'" & ActiveCell.Value
'Format all characters for black
With ActiveCell
    .Font.ColorIndex = 3
    'Format characters 5 thru 12 as red
    .Characters(1, ActiveCell.Characters.Count - 8).Font.ColorIndex = 1
    'Reformat characters 10 thru 12 back to black
    .Characters(10, ActiveCell.Characters.Count - 3).Font.ColorIndex = 1
End With
End Sub

您只需在所需的单元格上添加一个循环。

[Source]