Макрос для цикла по всем листам Excel и поиска ячеек, содержащих символы, которые я объявляю

Question

У меня есть этот макрос:

Sub Macro3()

Dim splChars As String
Dim ch As Variant
Dim splCharArray() As String

splChars = "! @ # $ % ^ & () /" splCharArray = Split(splChars, " ")

For Each ch In splCharArray
Cells.Replace What:="~" & ch, Replacement:="", LookAt:=xlPart, SearchOrder:= _
xlByRows, MatchCase:=True
Next ch

End Sub

Что он делает, так это то, что он заменяет все специальные символы, найденные на любом листе в моей книге, прямо сейчас я хочу избавиться от этих символов:!@ # $% ^ & () /.

Это как-то работает, но мне также нужен второй макрос, который бы просто делал Cells.Find для каждой ячейки в каждой книге, затем создавал новый лист и перечислял все адреса ячеек испециальные символы, найденные в любом из моих листов.

В Интернете я нашел это:

Public Sub SearchForText()
  Dim rngSearchRange As Range
  Dim vntTextToFind As Variant
  Dim strFirstAddr As String
  Dim lngMatches As Long
  Dim rngFound As Range

  On Error GoTo ErrHandler
  vntTextToFind = Application.InputBox( _
    Prompt:="Enter text to find:", _
    Default:="Search...", _
    Type:=2 _
  )
  If VarType(vntTextToFind) = vbBoolean Then Exit Sub

  On Error Resume Next
  Set rngSearchRange = Application.InputBox( _
    Prompt:="Enter range for search:", _
    Default:=ActiveCell.Parent.UsedRange.Address, _
    Type:=8 _
  )

  On Error GoTo ErrHandler
  If rngSearchRange Is Nothing Then Exit Sub
  Set rngFound = rngSearchRange.Find( _
    What:=CStr(vntTextToFind), _
    LookIn:=xlValues, _
    LookAt:=xlPart _
  )

  If rngFound Is Nothing Then
    MsgBox "No matches were found.", vbInformation
  Else
    With ThisWorkbook.Sheets.Add
      With .Range("A1:B1")
        .Value = Array("Cell", "Value")
        .Font.Bold = True
      End With
      strFirstAddr = rngFound.Address
      Do
        lngMatches = lngMatches + 1
        .Cells(lngMatches + 1, "A").Value = rngFound.Parent.Name & "!" _
                                          & rngFound.Address(0, 0)
        .Cells(lngMatches + 1, "B").Value = rngFound.Value
        Set rngFound = rngSearchRange.FindNext(rngFound)
      Loop Until (rngFound.Address = strFirstAddr)
      .Columns("A:B").AutoFit
    End With
  End If
  Exit Sub

ErrHandler:
  MsgBox Err.Description, vbExclamation
End Sub

Этот код прекрасно работает для меня, но моя единственная проблема в том, что мне нужно установитьдиапазон, в котором он ищет каждый раз, и это может быть только один лист, поэтому, по сути, если у меня есть 10 листов, мне нужно запустить этот макрос 10 раз, чтобы получить желаемый результат.

То, что я хотел бы сделать этот код, это взять каждый символ из этого набора символов:!@ # $% ^ & () / и на каждом рабочем листе моей рабочей книги найдите ячейки, содержащие указанные символы, а не только один лист, затем создайте новый лист и адрес возврата каждой ячейки во всей рабочей книге, которая содержит любой из моих объявленных символов (! @ # $% ^ & () /) и я не могу понять, как это сделать, я всегда получаю сообщение об ошибке.

Я новичок в VBA, поэтому я не знаю, что могуЯ изменяю, чтобы заставить его работать так, как я хочу, чтобы он работал.

Сначала я подумал, что могу просто объявить новую переменную ws как лист и перебрать все листы с одинаковым диапазоном, выбранным для каждого, но это не так.не работает для меня.

Что я могу изменить, чтобы заставить его работать?

Answer 1

Попробуй это.Вам просто нужен еще один цикл для рабочих таблиц и цикл для поиска.

Этот код не выполняет никакой замены.

Sub Macro3()

Dim splChars As String
Dim ch As Variant
Dim splCharArray() As String
Dim r As Range, s As String
Dim ws As Worksheet

splChars = "! @ # $ % ^ & () /"
splCharArray = Split(splChars, " ")

Sheets.Add().Name = "Errors" 'to list characters and location

For Each ch In splCharArray
    For Each ws In Worksheets
        If ws.Name <> "Errors" Then
            Set r = ws.Cells.Find(What:=ch, Lookat:=xlPart, SearchOrder:=xlByRows, MatchCase:=True, SearchFormat:=False)
            If Not r Is Nothing Then
                s = r.Address
                Do
                    Sheets("Errors").Range("A" & Rows.Count).End(xlUp)(2) = ch 'character
                    Sheets("Errors").Range("B" & Rows.Count).End(xlUp)(2) = r.Address(external:=True)
                    Set r = ws.Cells.FindNext(r)
                Loop Until r.Address = s 'loop until we are back to the first found cell
            End If
        End If
    Next ws
Next ch

End Sub