我在每个工作表的VBA循环中搞砸了什么？ [英] What have I messed up in the VBA loop for each worksheet?

问题描述

我目前必须一次发送多个字母，通常只能在单元格内替换1个或两个字。问题在于，我需要这些词来加粗，在150个工作表上单独使用这个宏将是乏味的。我非常新的编码，并尝试在线搜索编辑这个代码循环遍历所有的工作表，但我尝试的一切似乎只是改变了我目前的工作表。下面是我当前的代码，我认为会导致循环，而不是循环通过工作表，它似乎只循环通过单个工作表，我问，是否要在该表上加粗另一个单词。

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.

原始码：

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提供的工作代码：

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

推荐答案

您正在设置一个循环来浏览每个工作表（使用 ws 作为您当前正在处理的工作表的引用），然后处理 ActiveSheet 之间的范围。使用 ws 而不是 ActiveSheet 。

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.

您还应该在尝试将其设置为 UsedRange.SpecialCells rng 设置为 Nothing $ c>或者，如果这个崩溃了，你的如果rng不是，那么语句将不起作用（因为 rng 仍将被设置为通过循环在上一次迭代中设置的任何内容）。

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

这篇关于我在每个工作表的VBA循环中搞砸了什么？的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！