Question

我目前必须同时发送多个字母，并且通常只替换单元格中的1个或2个字。问题是我需要将这些单词加粗，在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

我最近的尝试：

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

Answer 1

您正在设置循环以浏览每个工作表（使用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 '...仍将被设置为通过循环在前一次迭代中设置的任何内容。）

stateToHTML

我在每个工作表的VBA循环中搞砸了什么？

1 个答案: