Fehler abfangen

Informationen und Beispiele zu den hier genannten Dialog-Elementen:
MsgBox
Bild

Betrifft: Fehler abfangen
von: Armin
Geschrieben am: 24.04.2015 11:05:10

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

Bild

Betrifft: AW: Fehler abfangen
von: Nepumuk
Geschrieben am: 24.04.2015 11:22:57
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

Bild

Betrifft: Korrektur
von: Nepumuk
Geschrieben am: 24.04.2015 11:30:11
Hallo,
die Abfrage muss so erfolgen:

If Range(.Cells(1, 1), .Cells(.Rows.Count, 10)).SpecialCells(xlCellTypeVisible).Rows.Count > 1 Then
Gruß
Nepumuk

Bild

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

Bild

Betrifft: AW: Korrektur
von: Nepumuk
Geschrieben am: 24.04.2015 11:56:43
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

Bild

Betrifft: AW: Korrektur - das geht so nicht!
von: Daniel
Geschrieben am: 24.04.2015 12:13:39
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

Bild

Betrifft: AW: Fehler abfangen - mit CountIf
von: Daniel
Geschrieben am: 24.04.2015 12:01:37
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

Bild

Betrifft: AW: Fehler abfangen - mit prüfen der sichtbaren
von: Daniel
Geschrieben am: 24.04.2015 12:08:33
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

Bild

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

 Bild

Beiträge aus den Excel-Beispielen zum Thema "Fehler abfangen"