时间戳

首页 > 解决方案 > 遍历所有工作表以查找包含特殊字符的单元格

excel - 遍历所有工作表以查找包含特殊字符的单元格

问题描述

我有这个宏来替换工作簿中任何工作表中的特殊字符。

它摆脱了这些字符：！@#$​​%^&()/

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 次以获得所需的结果。

我想在我的工作簿的每个工作表中搜索每个字符，然后创建一个新工作表并返回包含我声明的任何字符的整个工作簿中每个单元格的地址。

我想我可以将新变量 ws 声明为工作表，并循环使用为每个工作表选择的相同范围的所有工作表。

标签： excelvbasearch

解决方案

试试这个。您只需要另一个循环用于工作表，以及一个循环用于查找。

此代码不进行任何替换。

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

推荐阅读