在vba中的宏,在某些单元格中找到一些字符串

时间:2014-03-12 15:02:44

标签: excel vba

我尝试做一个可以在某些单元格中找到某些字符串的宏,但是我有一个错误。

我的代码是:

Sub MACRO()
    bAlerts = Application.DisplayAlerts
    Application.DisplayAlerts = False
    Dim Totalrows As Integer
    Dim Totalcols As Integer
    Dim Valor As String
    For i = 1 To Worksheets.Count
        Totalrows = Worksheets(i).UsedRange.rows.Count
        Totalcols = Worksheets(i).UsedRange.Columns.Count
        For r = 1 To Totalrows
            For c = 1 To Totalcols
                If InStr(Worksheets(i).Cells(r, c), "cadena buscada") > 0 Then
                    MsgBox "Se encontró una coincidencia"
                End If
            Next c
        Next r
    Next i
    Application.DisplayAlerts = bAlerts
End Sub

我在这行中有错误:

If InStr(Worksheets(i).Cells(r, c), "cadena buscada") > 0 Then

任何人都知道错误在哪里?

谢谢!

3 个答案:

答案 0 :(得分:0)

  

我想找的字符串,是这样的公式= C:\ Gestion ...

最可能的问题是工作表上的单元格包含错误,例如#N/A#DIV/0!等等。

循环通过每个单元格是无效的。改为使用.Find方法:

Sub MACRO()
    Dim bAlerts
    Dim LastRow As Long
    Dim LastCol As Long
    Dim ws As Worksheet
    Dim rng As Range
    Dim fAddr As String

    bAlerts = Application.DisplayAlerts
    Application.DisplayAlerts = False

    For Each ws In ThisWorkbook.Worksheets
        With ws.UsedRange
            Set rng = .Find(What:="cadena buscada", _
                                        LookIn:=xlFormulas, _
                                        LookAt:=xlPart, _
                                        MatchCase:=False)
            If Not rng Is Nothing Then
                fAddr = rng.Address
                Do
                    MsgBox "Match found in sheet: " & ws.Name & ", cell: " & rng.Address
                    Set rng = .FindNext(rng)
                    If rng Is Nothing Then Exit Do
                Loop While fAddr <> rng.Address
            End If
        End With
    Next ws
    Application.DisplayAlerts = bAlerts
End Sub

我还将For i = 1 To Worksheets.Count更改为For Each ws In Worksheets,因为它稍快一些。

答案 1 :(得分:0)

将列和行计数更新为更稳定的提取集[link],以便它与整个工作表使用范围相关联,而不是在空白单元格上打破的标准化使用范围。

Sub MACRO()
    bAlerts = Application.DisplayAlerts
    Application.DisplayAlerts = False
    Dim Totalrows As Integer
    Dim Totalcols As Integer
    Dim Valor As String
    For i = 1 To Worksheets.Count
        Totalrows = Cells.Find("*", [A1], , , xlByRows, xlPrevious).Row
        Totalcols = Cells.Find("*", [A1], , , xlByColumns, xlPrevious).Column
        For r = 1 To Totalrows
            For c = 1 To Totalcols
                If InStr(Worksheets(i).Cells(r, c), "cadena buscada") > 0 Then
                    MsgBox "Se encontró una coincidencia"
                End If
            Next c
        Next r
    Next i
    Application.DisplayAlerts = bAlerts
End Sub

答案 2 :(得分:0)

查看您在任何已使用的单元格中是否有错误,如果是这样,请将其添加到您的代码中:

if not IsError(worksheets(i).cells(r,c)) then
  if InStr....

为了更接近效率,请尝试使用此代码

Sub MACRO1()
Dim ws As Worksheet
Dim rng As Range
Dim fAddr As String, p As Long
Set ws = Sheet1
    With ws.UsedRange
        Set rng = .Find(What:=18, _
                                    LookIn:=xlFormulas, _
                                    LookAt:=xlPart, _
                                    MatchCase:=False)
        If Not rng Is Nothing Then
            fAddr = rng.Address
            Do
                p = p + 1
                Set rng = .FindNext(rng)
                If rng Is Nothing Then Exit Do
            Loop While fAddr <> rng.Address
        End If
    End With
'MsgBox p
End Sub

Sub macro2()
Dim ws, c, p As Long
Set ws = Sheet1.UsedRange
For Each c In ws
 If c = 18 Then
  p = p + 1
  End If
Next
'MsgBox p
End Sub
Sub macro3()
Dim ws, c, p As Long, v
Dim nr As Long, nc As Long, r As Long
Set ws = Sheet1.UsedRange
nr = ws.Rows.Count
nc = ws.Columns.Count
v = ws
For r = 1 To nr
 For c = 1 To nc
  If v(r, c) = 18 Then
   p = p + 1
  End If
 Next
Next
'MsgBox p
End Sub

Sub TimeIt()
Dim t1 As Single, t2 As Single
Dim p As Integer, t3 As Single
t1 = Timer
For p = 1 To 300
 MACRO1
Next
t1 = Timer - t1
t2 = Timer
For p = 1 To 300
 macro2
Next
t2 = Timer - t2
t3 = Timer
For p = 1 To 300
 macro3
Next
t3 = Timer - t3
MsgBox t1 & Chr(13) & t2 & Chr(13) & t3
End Sub

使用大约A1:Z250的范围填充整数随机数1-20并查找值18的所有匹配,在我的计算机中时间是:

macro1 (using Find) 5.76 secs
macro2 (looping with For each) 3.94 secs
macro3 (looping using an array) 0.6 secs

如果只有一个匹配的macro1和macro3同时花费了0.6秒

因此,如果我们有几个可能的匹配,那么FIND效率最低(在这种情况下,差不多9倍。