Cells.Find findet tlw. Quatsch, Error handler?

Sub DatenJoiner() Dim Suchen As String Dim Zeile As Integer On Error Resume Next For a = 2 To 2700 Suchen = Worksheets("Data").Cells(a, 2) Worksheets("ZIEL").Activate Zeile = Cells.Find(what:=Suchen, after:=Range("A1")).Row Worksheets("Data").cells(a,3) = Worksheets("ZIEL").cells(Zeile,1) Next a End Sub

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Hallo
"...Geht wegen dem NOT Zeile nicht, Zeile ist nicht Boole'sche, ..."
Wer sagt das ?
Dann stimmt dein Code im grundsätzlichen Aufbau schon nicht.
Hier mal ein Beispiel das funktioniert
Sub Extinguisher_MultiSeek()
    '(C) by Ramses
    'Sucht in der gesamten Mappe nach einem Begriff und kopiert die
    'gefundene Zeile in eine zu definfierende Ergebnistabelle
    'Addiert den Wert rechts von der gefundenen Zelle
    'und erstellt gleichzeitig Hyperlinks auf die Fundstellen
    'in der Ergebnistabelle
    Dim sResultName As String
    Dim sWks As Worksheet, tarWks As Worksheet
    Dim sRng As Range
    Dim sAddress As String
    Dim Qe As Integer, i As Integer
    Dim fString As Integer, fUnit As Integer
    'Suchbegriff
    Dim sFind As Variant
    Dim cr As Long
    fString = 0
    fUnit = 0
    'Name_der_Zieltabelle
    'Bitte Anpassen !!!!
    sResultName = "Suchergebnis"
    'Prüfzyklus
    For i = 1 To Worksheets.count
        If Worksheets(i).name = sResultName Then
            Qe = MsgBox("Ergebnistabelle existiert schon!" & vbCrLf & _
                "Tabelle löschen ?", vbCritical + vbYesNo, "Wie weiter ... ?")
            If Qe = vbNo Then
                MsgBox "Makro wird abgebrochen"
                Exit Sub
            End If
            Application.DisplayAlerts = False
            Worksheets(i).Delete
            Application.DisplayAlerts = True
            Exit For
        End If
    Next i
    'Suchbegriff anfordern
    sFind = InputBox("Bitte Suchbegriff eingeben:", "Suche nach", "Feuerlöscher")
    If sFind = "" Then
        Qe = MsgBox("Kein Suchbegriff angegeben", vbInformation + vbOKOnly, "Abbruch")
        Exit Sub
    End If
    'Alternativ Suchbegriff auf Zelle definieren
    'sFind = Worksheets(sresultname).Range("B1")
    'Ergebnistabelle vorbereiten
    Worksheets.Add.name = sResultName
    Set tarWks = Worksheets(sResultName)
    With tarWks
        .Range("A1") = "Suchkriterium"
        .Range("B1") = sFind
        .Range("A3") = "Tabellenname"
        .Range("B3") = "Anzahl"
    End With
    'Startzeile für Ergebnisse definieren
    cr = 4
    For Each sWks In Worksheets
        If sWks.name <> tarWks.name Then
            'Suchbegriff suchen
            Set sRng = sWks.Cells.Find(What:=sFind, _
                LookAt:=xlPart, LookIn:=xlFormulas)
            If Not sRng Is Nothing Then
                'Fundstellen merken
                sAddress = sRng.Address
                Do
                    Application.Goto sRng, True
                    'Eintragen in ERgebnistabelle
                    tarWks.Cells(cr, 1) = sWks.name
                    'Hyperlink auf Suchergebnis erstellen
                    tarWks.Cells(cr, 1).Hyperlinks.Add Anchor:=tarWks.Cells(cr, 1), _
                        Address:="", SubAddress:=sWks.name & "!" & sRng.Address, TextToDisplay:=sWks.name
                    'Zellwert übertragen
                    tarWks.Cells(cr, 2) = sRng.Offset(0, 1).Value
                    'zeilenzähler aktivieren
                    cr = cr + 1
                    'Zählvariablen updaten
                    fString = fString + 1
                    fUnit = fUnit + sRng.Offset(0, 1).Value
                    'Nächsten Suchbegriff in der Tabelle suchen
                    Set sRng = sWks.Cells.FindNext(after:=ActiveCell)
                    'Wenn nicht vorhanden
                    'gehts zur nächsten Tabelle
                    If sRng.Address = sAddress Then Exit Do
                Loop
            End If
        End If
        NextStart:
    Next sWks
    tarWks.Select
    Qe = MsgBox("Suchbegriff: " & sFind & " wurde " & fString & " mal gefunden." & vbCrLf & _
        "Total werden: " & fUnit & " benötigt. ", vbInformation + vbOKOnly, "Suche abgeschlossen")
End Sub

Gruss Rainer

Sub DatenJoiner() Dim Suchen As String Dim Zeile As Integer Dim Erg As Range For a = 2 To 2700 Suchen = Worksheets("Data").Cells(a, 2) Worksheets("ZIEL").Activate Set Erg = Cells.Find(what:=Suchen, after:=Range("A1")) If Not Erg Is Nothing Then Zeile = Erg.Row Worksheets("Data").Cells(a, 3) = Worksheets("ZIEL").Cells(Zeile, 1) End If Next a End Sub

Sub DatenJoiner() ' Der Code sucht 2699 in "Data" angegebene Werte in Blatt "ZIEL" ' und überträgt - wenn gefunden - den Inhalt von Spalte A der Zeile, ' in der der gefundene Wert steht, nach Spalte C von "Data". ' Dass ein Suchbegriff mehrfach in "ZIEL" vorkommen kann, wird nicht ' berücksichtigt. Nur die erste Fundstelle wird verarbeitet. Dim a As Long Dim Erg As Range Worksheets("ZIEL").Activate For a = 2 To 2700 Set Erg = Cells.Find(what:=Worksheets("Data").Cells(a, 2), _ after:=Range("A1")) If Not Erg Is Nothing Then _ Worksheets("Data").Cells(a, 3) = Cells(Erg.Row, 1) Next a End Sub

Sub DatenJoiner() Dim Suchen As String Dim Zeile As Integer On Error GoTo naechstes_a For a = 2 To 2700 Suchen = Worksheets("Data").Cells(a, 2) If Suchen = "" Then GoTo naechstes_a 'Leere Zellen abfangen Worksheets("ZIEL").Activate Zeile = Cells.Find(what:=Suchen, after:=Range("A1")).Row Worksheets("Data").Cells(a, 3) = Worksheets("ZIEL").Cells(Zeile, 1) naechstes_a: Next a End Sub

Sub DatenJoinerForum() Dim Suchen As String Dim Zeile As Integer Dim Erg As Range For a = 2 To 2700 Suchen = Worksheets("Data TEST").Cells(a, 2) Worksheets("ZIEL TEST").Activate Set Erg = Cells.Find(what:=Suchen, after:=Range("A1"), LookAt:=xlWhole) If Not Erg Is Nothing Then Zeile = Erg.Row Worksheets("DATA TEST").Cells(a, 12) = Worksheets("ZIEL Test").Cells(Zeile, 5) End If Next a End Sub

Beliebteste Forumthreads (12 Monate)

Cells.Find findet tlw. Quatsch, Error handler?

12
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

Cells.Find findet tlw. Quatsch, Error handler?

12 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu verwandten Themen

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

12
Beiträge zum Forumthread

Beiträge zu diesem Forumthread