我在每个工作表的VBA循环中弄乱了什么?

我现在必须一次发送多个字母,并且经常只replace一个单元格中的一两个字。 问题是我需要将这些单词加粗,在150个工作表上单独使用这个macros将会非常繁琐。 我是非常新的编码,并试图在网上search编辑此代码循环所有的工作表,但我所尝试的一切似乎只改变我目前的工作表。 下面是我目前的代码与我认为会导致循环,而不是循环通过工作表,似乎只循环通过单个工作表我问,如果我想在该表上粗体字。

原始码:

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 

我最近的尝试:

 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 

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 

您正在设置一个循环来遍历每个工作表(使用ws作为您当前正在处理的工作表的引用),然后在ActiveSheet上处理一个范围。 使用ws而不是ActiveSheet

你也应该将rng设置为Nothing然后尝试将其设置为UsedRange.SpecialCells ,否则,如果发生崩溃,那么您的If rng Is Nothing Then语句将不起作用(因为rng仍将被设置为任何设置为先前通过循环迭代)。

 '... 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 '...