What have I messed up in the VBA loop for each worksheet?

问题

I currently have to send multiple letters out at one time and often replace only 1 or two words within a cell. The problem is that I need those words to be bolded and it would be tedious to use this macro individually on 150 worksheets. I am very new to coding and have tried to search online to edit this code to loop through all of the worksheets, but everything I try seems to only change the current sheet I am on. Below is my current code with what I thought would cause the loop, but instead of looping through the worksheets it seems to only loop through the single worksheet I am on, asking if I would like to bold another word on that sheet.

Origanal code:

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

My most recent attempt:

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
For Each ws In ActiveWorkbook.Worksheets

   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
Next ws
ExitHandler:
    Set rCell = Nothing
    Set rng = Nothing
    Exit Sub

ErrHandler:
    MsgBox Err.Description
    Resume ExitHandler
End Sub

Corrected working code provided provided by YowE3K:

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

   For Each ws In ActiveWorkbook.Worksheets
    Set rng = Nothing
    Set rng = ws.UsedRange.SpecialCells(xlCellTypeConstants, xlTextValues)
    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 on worksheet '" & ws.Name & "'."
    ElseIf lCount = 1 Then
        MsgBox "One occurrence of" & _
          vbCrLf & "' " & sFind & " '" & _
          vbCrLf & "was made bold on worksheet '" & ws.Name & "'."
    Else
        MsgBox lCount & " occurrences of" & _
          vbCrLf & "' " & sFind & " '" & _
         vbCrLf & "were made bold on worksheet '" & ws.Name & "'."
    End If
Next ws
ExitHandler:
    Set rCell = Nothing
    Set rng = Nothing
    Exit Sub

End Sub

回答1:

You are setting up a loop to go through each worksheet (using ws as your reference to the sheet currently being processed), but then processing a range on the ActiveSheet. Use ws instead of ActiveSheet.

You should also set rng to Nothing before attempting to set it to the UsedRange.SpecialCells or else, if that crashes, your If rng Is Nothing Then statement won't work (because rng will still be set to whatever it was set to on the previous iteration through the loop).

'...
For Each ws In ActiveWorkbook.Worksheets
    Set rng = Nothing
    On Error Resume Next
    Set rng = ws.UsedRange.SpecialCells(xlCellTypeConstants, xlTextValues)
    On Error GoTo ErrHandler
    If rng Is Nothing Then
'...

来源：https://stackoverflow.com/questions/43083108/what-have-i-messed-up-in-the-vba-loop-for-each-worksheet