Live-Forum - Die aktuellen Beiträge
Datum
Titel
19.04.2024 10:59:29
Datei Auswählen und öffnen
19.04.2024 10:46:47
Bestimmte Zellen aus dynamischer Liste zurückgeben
19.04.2024 10:39:36
Schaltfläche auf einem Tabellenblatt NICHT mit abspeichern
19.04.2024 09:26:26
Median für Zeilen mit gleichen Zeitstempel
Du findest keine passende Antwort auf Deine Frage?
Stelle Deine Frage in unserem Live-Forum
Anzeige
Archiv - Navigation
1420to1424
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Vorheriger Thread
Vorheriger Thread
Rückwärts Blättern
1420to1424
1420to1424
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Nächster Thread
Nächster Thread
Vorwärts blättern
Inhaltsverzeichnis

Fehler abfangen

Fehler abfangen
24.04.2015 11:05:10
Armin
Hallo zusammen,
folgender code funktioniert so weit. Wenn ich jetzt aber nach einer Selektion Filtere zu der es keine Ergebnisse gibt kommt ein Fehler.
Hier hätte ich gerne eine MSG Box ("keine Daten gefunden") und dann muss der code aber trotzdem weiterlaufen und den Filter wieder aufheben.
Kann bitte jemand helfen ? 
Sub test()
With Worksheets("Auskunft")
Range("a8:J29").ClearContents
End With
sped = Worksheets("Auskunft").Range("c1").Value
Worksheets("Quelle").Range("A7:o250").AutoFilter Field:=3, Criteria1:=sped
Worksheets("Quelle").Range("A8:J" & ActiveSheet.UsedRange.Rows.Count). _
SpecialCells(xlCellTypeVisible).Copy
Worksheets("Auskunft").Range("A8").PasteSpecial
If Sheets("Quelle").FilterMode Then Sheets("Quelle").ShowAllData
End Sub

8
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Fehler abfangen
24.04.2015 11:22:57
Nepumuk
Hallo,
teste mal so:
Public Sub CopyFilterData()
    Worksheets("Auskunft").Range("A8:J29").ClearContents
    With Worksheets("Quelle")
        .Rows(7).AutoFilter Field:=3, Criteria1:=Worksheets("Auskunft").Range("C1").Value
        With .AutoFilter.Range
            If Range(.Cells(2, 1), .Cells(.Rows.Count, 10)).Rows.Count > 0 Then
                Range(.Cells(2, 1), .Cells(.Rows.Count, 10)).Copy _
                    Destination:=Worksheets("Auskunft").Range("A8")
            Else
                MsgBox "Keine Daten gefunden.", vbExclamation, "Hinweis"
            End If
        End With
        .ShowAllData
    End With
End Sub

Gruß
Nepumuk

Anzeige
Korrektur
24.04.2015 11:30:11
Nepumuk
Hallo,
die Abfrage muss so erfolgen:
If Range(.Cells(1, 1), .Cells(.Rows.Count, 10)).SpecialCells(xlCellTypeVisible).Rows.Count > 1 Then
Gruß
Nepumuk

AW: Korrektur
24.04.2015 11:47:17
Armin
Leider bekomme ich jetzt immer "400"
las Fehlermeldung und es kopiert garnichts mehr.
Gruß Armin

AW: Korrektur
24.04.2015 11:56:43
Nepumuk
Hallo,
das ist einer der unerklärlichen Fehler von Microsoft. Kopiere mal deine Daten in eine neue Tabelle und lösch die alte. Wenn's nicht hilft, dann kopiere die Tabelle in eine neue Mappe, verfälsche die Daten (es genügt wenn überall ein x drin steht) und lade die hoch.
Gruß
Nepumuk

Anzeige
AW: Korrektur - das geht so nicht!
24.04.2015 12:13:39
Daniel
Hi
Rows.Count funktioniert nur in lückenlos zusammenhängenden Zellbereichen.
Besteht der Gesamtbereich aus mehren Zellblöcken (Areas) - was bei einer filterung zu erwarten ist -, zählt Rows.Count nur die Zeilen des ersten Blocks.
der Worksaround wäre hier, den Zellbereich auf eine Spalte einzschränken und die Zellen zu zählen.
Denn Cells.Count funkioniert auch bei Zellbereichen mit mehrern Areas und wenn man nur eine Spalte verwendet, ist die Anzahl der Zellen gleich der Anzahl der Zeilen.
If Range(.Cells(1, 1), .Cells(.Rows.Count, 1)).SpecialCells(xlCellTypeVisible).Cells.Count > 1 Then
Gruß Daniel

Anzeige
AW: Fehler abfangen - mit CountIf
24.04.2015 12:01:37
Daniel
Hi
wenn du nur dass eine Filterkriterium hast, dann kannst du schon vor dem Filtern mit Worksheetfunction.CountIf prüfen, ob der gesuchte Wert in der Liste vorhanden ist:
sped = Worksheets("Auskunft").Range("c1").Value
If WorksheetFunction.CountIf(Worksheets("Quelle").Columns(3), sped) = 0 Then
MsgBox "Suchbegriff nicht vorhanden"
Else
'hier den Code zum Filtern und Kopieren einfügen
End If
Gruß Daniel

AW: Fehler abfangen - mit prüfen der sichtbaren
24.04.2015 12:08:33
Daniel
Hi
oder so:
Sub test()
With Worksheets("Auskunft")
.Range("a8:J29").ClearContents
sped = .Range("c1").Value
End With
With Worksheets("Quelle").Range("A7:O250")
.AutoFilter Field:=3, Criteria1:=sped
If .Columns(1).SpecialCells(xlCellTypeVisible).Cells.Count > 1 Then
.Offset(1, 0).Resize(.Rows.Count - 1, 10).SpecialCells(xlCellTypeVisible).Copy
Worksheets("Auskunft").Range("A8").PasteSpecial
Else
MsgBox "keine Daten vorhanden"
End If
End With
If Sheets("Quelle").FilterMode Then Sheets("Quelle").ShowAllData
End Sub
Gruß Daniel

Anzeige
AW: Fehler abfangen - mit prüfen der sichtbaren
28.04.2015 09:13:19
Armin
vielen Dank,
funktioniert super
Gruß Armin

Beliebteste Forumthreads (12 Monate)

Anzeige
Jetzt das Excel-Portal bewerten: Deine Stimme zählt!

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige