我目前必须同时发送多个字母,并且通常只替换一个单元格中的一个或两个单词。问题是我需要将这些单词加粗,在150个工作表上单独使用这个宏会很繁琐。我对编码很新,并尝试在线搜索以编辑我的代码,但我尝试的所有内容似乎只会改变我当前的工作表。我希望得到一个固定的代码,并对变化进行解释,这样我就可以了解将来如何解决这个问题。
Sub FindAndBold()
Dim ws As Worksheet
Dim sFind As String
Dim rCell As Range
Dim rng As Range
Dim lCount As Long
Dim iLen As Integer
Dim iFind As Integer
Dim iStart As Integer
On Error Resume Next
Set rng = ActiveSheet.UsedRange. _
SpecialCells(xlCellTypeConstants, xlTextValues)
On Error GoTo ErrHandler
If rng Is Nothing Then
MsgBox "There are no cells with text"
GoTo ExitHandler
End If
sFind = InputBox( _
Prompt:="What do you want to BOLD?", _
Title:="Text to Bold")
If sFind = "" Then
MsgBox "No text was listed"
GoTo ExitHandler
End If
iLen = Len(sFind)
lCount = 0
For Each rCell In rng
With rCell
iFind = InStr(.Value, sFind)
Do While iFind > 0
.Characters(iFind, iLen).Font.Bold = True
lCount = lCount + 1
iStart = iFind + iLen
iFind = InStr(iStart, .Value, sFind)
Loop
End With
Next
If lCount = 0 Then
MsgBox "There were no occurrences of" & _
vbCrLf & "' " & sFind & " '" & _
vbCrLf & "to bold."
ElseIf lCount = 1 Then
MsgBox "One occurrence of" & _
vbCrLf & "' " & sFind & " '" & _
vbCrLf & "was made bold."
Else
MsgBox lCount & " occurrences of" & _
vbCrLf & "' " & sFind & " '" & _
vbCrLf & "were made bold."
End If
ExitHandler:
Set rCell = Nothing
Set rng = Nothing
Exit Sub
ErrHandler:
MsgBox Err.Description
Resume ExitHandler
End Sub