Suche nach einer bestimmten Zeichenfolge in einer Excel-Arbeitsmappe

Question

Also, ich muss ein Excel-Makro in VBA, die nach einer Zeichenfolge suchen, dann vergleichen Sie es mit einer voreingestellten Zeichenfolge meiner Wahl und ändern Sie den Wert einer Zelle in ein anderes Blatt.

Es geht so:

Sub Macro1() 

Dim A As Integer 
Dim WS As Worksheet 

Dim ToCompare, Coniburo As String 

Coniburo = "My String" 

For Each WS In Worksheets 
    For A = 1 To Rows.Count 
    ToCompare = Left(Cells(A, 3), 100) 
     If InStr(ToCompare, Coniburo) > 0 Then 
      Sheets("Last Sheet").Cells(21, 2).Value = "233" 
     End If 
    Next A 
Next 

Das Makro funktioniert ....... Wenn entferne ich die erste für (die, die durch eine Suchoption) und solange ich in einem Blatt bin wo "Meine Zeichenfolge" vorhanden ist. Ansonsten funktioniert es nicht. Es dauert eine lange Zeit zu verarbeiten, über eine Minute, da es 17 Blätter gibt.

Warum funktioniert nicht? Ich habe hier viele Posts gelesen, das Microsoft Dev Forum, eine Seite namens Tech on the Net, und immer noch fehlt mir etwas, aber ich weiß nicht warum.

Kann mir jemand in die richtige Richtung zeigen?

Answer 1

Verwenden Sie A With ... End With, um das übergeordnete Arbeitsblatt für jede Iteration der Schleife zu konzentrieren.

Option Explicit 

Sub Macro1() 
    Dim a As Long, Coniburo As String, ws As Worksheet 

    Coniburo = "My String" 

    For Each ws In Worksheets 
     With ws 
      For a = 1 To .Cells(.Rows.Count, "C").End(xlUp).Row 
       If CBool(InStr(Left(.Cells(a, 3), 100), Coniburo, vbTextCompare)) Then 
        Worksheets("Last Sheet").Cells(21, 2).Value = 233 
       End If 
      Next a 
     End With 
    Next 

End Sub 

Sie müssen Zeilen Präfix, ruft Bereich und Zellen mit einer Periode wie .Rows... oder .Range(...) oder .Cells(...) wenn sie in einem mit ... End With-Block. Dadurch werden sie mit dem übergeordneten Arbeitsblatt identifiziert, das mit With .. End With beschrieben wird.

Ich machte auch den Vergleich case-insensitive mit vbTextCompare.

Es gibt das verbleibende Problem, 233 in dieselbe Zelle auf demselben Arbeitsblatt zu schreiben und neu zu schreiben, aber das ist eine andere Sache.

Answer 2

Ich habe die Regeln ein wenig gebeugt, aber ich möchte zeigen, wie wir die eingebaute FIND-Funktion verwenden können, um die Dinge dramatisch zu beschleunigen. Wir werden einfach jedes Blatt in Spalte C bearbeiten. Wir werden die FIND-Funktion verwenden, um die Zeilennummer zu finden, in der Spalte C Ihren Suchbegriff enthält .... dann überprüfen wir diese Zelle, um zu sehen, ob Ihr Suchbegriff je nach Anforderung innerhalb der ersten 100 Zeichen liegt. Wenn ja, betrachten wir das als Übereinstimmung. Zusätzlich zu Ihrem Ergebnis der Protokollierung „233“ in das Blatt „Letzte Seite“ Ich habe einige helle grüne Markierung enthalten nur zu helfen, zu sehen, was los ist ...

Sub findConiburo() 
    Coniburo = "My String" 
    For Each ws In Worksheets 
     With ws.Range("C:C") 
      myName = ws.Name 'useful for debugging 

      queue = 1 'will be used to queue the FIND function 

      x = 0 'loop counter 

      Do 'loop to find multiple results per sheet 

       On Error Resume Next 'Disable error handling 

       'FIND Coniburo within ws column C, log row number: 
       'Note ".Cells(queue, 1)" is a relative reference to the current WS, column C 
       foundRow = .Find(What:=Coniburo, After:=.Cells(queue, 1), LookIn:=xlFormulas, LookAt _ 
        :=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _ 
        False, SearchFormat:=False).Row 

       'If no result found then an error number is stored. Perform error handling: 
       If Err.Number <> 0 Then 
        'No results found, don't do anything, exit DO to skip to next sheet: 
        Exit Do 
       End If 
       On Error GoTo 0 'Re-enable error handling 

       If x = 0 Then 
        'first loop - log the first row result: 
        originalFoundRow = foundRow 
       ElseIf foundRow = originalFoundRow Then 
        'Not the first loop. Same result as original loop = we're back at the start, so exit loop: 
        Exit Do 
       End If 

       'Update queue so next loop will search AFTER the previous result: 
       queue = foundRow 

       'check if the string is not only SOMEWHERE in the cell, 
       'but specifically within the first 100 characters: 
       ToCompare = Left(.Cells(foundRow, 1), 100) 
       If InStr(ToCompare, Coniburo) > 0 Then 
        .Cells(foundRow, 1).Interior.ColorIndex = 4 'highlight green 
        Sheets("Last Sheet").Cells(21, 2).Value = "233" 
       End If 

       'Update loop counter: 
       x = x + 1 
      Loop 
     End With 
    Next ws 
End Sub