Live-Forum - Die aktuellen Beiträge
Datum
Titel
24.04.2024 00:20:14
Bestimmte Spalten als xls exportieren per Makro
23.04.2024 22:08:10
Auflisten in Spalte VBA
23.04.2024 21:33:46
Nur farbige/nicht farbige Zellen markieren
23.04.2024 21:29:56
Bestimmte Zellen auf andere Arbeitsblätter kopieren
Du findest keine passende Antwort auf Deine Frage?
Stelle Deine Frage in unserem Live-Forum
Anzeige
Archiv - Navigation
528to532
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
528to532
528to532
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Nächster Thread
Nächster Thread
Vorwärts blättern
Inhaltsverzeichnis

Fehler auffangen

Fehler auffangen
09.12.2004 06:46:33
Josef
Guten Morgen!
Ich habe folgenden VBA Text:

Sub Übertragen_AA() ' Übertrag AA  EPAK
Dim Wert As Variant
'Wert = Application.InputBox("AA  EPAK")
Wert = Application.InputBox("Aufforderung:", "Titel", "AA  EPAK")
If Wert = "" Or Wert = False Then Exit Sub
Dim iCol, iLZ, ICount, iZ, iR As Integer
Dim C As Range
For iCol = 1 To 5
If Cells(65536, iCol).End(xlUp).Row > ICount Then
ICount = Cells(65536, iCol).End(xlUp).Row
iLZ = iCol
End If
Next iCol
For iZ = 1 To ICount
With Rows(iZ)
Set C = .Find(What:=Wert, LookAt:=xlPart, SearchOrder:=xlByRows)
If Not C Is Nothing Then
iR = C.Row
With Sheets("Tabelle2")
Range(Cells(iR, 1), Cells(iR, 16)).Copy _
Destination:=.Cells(.Cells(65536, 1).End(xlUp).Row + 1, 1)
End With
End If
End With
Next iZ
End Sub



Sub Übertrag_Ärzte()
Call Sheet_leeren
Call Übertragen_AA 'Übertrag AA  EPAK
Sheets("Tabelle2").Select  'Tabelle2 aktivieren
Call TextInSpalteDLöschen  'Text in SpalteD löschen
Call past_Tab2_D 'SpalteD markieren und Formel kopieren
Call TextInSpalteCLöschen 'SpalteC löschen
Call Teilung
Call Fachgebiete
Call SpalteB
Call Überschrift_Ärzte
Call Endblatt
Call Speichern
End Sub

Wenn jetzt der Wert AA EPAK nicht gefunden wird, so soll die ganze Prozedur beendet werden und die Meldung kommen: AA EPAK wurde nicht gefunden.
Wird jetzt jedoch der Wert AA EPAK gefunden, so soll die ganze Prozedur vollzogen werden.
Wie kann ich diesen Fehler bitte auffangen?
Danke
Josef

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

Betreff
Datum
Anwender
Anzeige
AW: Fehler auffangen
WernerB.
Hallo Josef,
versuche es mal damit (ungetestet):

Sub Übertragen_AA() ' Übertrag AA  EPAK
Dim Wert As Variant
Dim iCol, iLZ, ICount, iZ, iR As Integer
Dim C As Range
'Wert = Application.InputBox("AA  EPAK")
Wert = Application.InputBox("Aufforderung:", "Titel", "AA  EPAK")
If Wert = "" Or Wert = False Then Exit Sub
For iCol = 1 To 5
If Cells(65536, iCol).End(xlUp).Row > ICount Then
ICount = Cells(65536, iCol).End(xlUp).Row
iLZ = iCol
End If
Next iCol
For iZ = 1 To ICount
With Rows(iZ)
Set C = .Find(What:=Wert, LookAt:=xlPart, SearchOrder:=xlByRows)
If Not C Is Nothing Then
iR = C.Row
With Sheets("Tabelle2")
Range(Cells(iR, 1), Cells(iR, 16)).Copy _
Destination:=.Cells(.Cells(65536, 1).End(xlUp).Row + 1, 1)
End With
Else
MsgBox "AA EPAK wurde nicht gefunden !" & vbCr & vbCr & _
"Makro-Abbruch !", vbCritical, "Dezenter Hinweis für " & _
Application.UserName & ":"
Exit Sub
End If
End With
Next iZ
End Sub

Viel Erfolg wünscht
WernerB.
Anzeige
AW: Fehler auffangen
09.12.2004 07:41:22
Josef
Hallo Werner!
Funktioniert leider nicht.
Obwohl AA EPAK gefunden wird, kommt die Meldung, dass nichts gefunden wurde, und die anschliessenden Makros werden weiter ausgeführt.
z.B.

Sub past_Tab2_D()
On Error Resume Next
Dim rngCell As Range
Call Markier_D  'SpalteD markieren
For Each rngCell In Selection
rngCell.FormulaR1C1 = "=MID(RC[-1],24,5)" 'Formel kopieren
Next
Wert_einfügen2 'Einfügen als Werte
End Sub

In Tabelle2 wird in mehreren Spalten die Formel eingetragen.
Josef
AW: Fehler auffangen
09.12.2004 07:46:51
Josef
Hallo Werner!
Wäre es nicht möglich, dass wenn der Wert nicht gefunden wird, die Tabelle2 gar nicht aktiviert wird? Dann würden ja auch nicht die Makros weiter abgearbeitet werden.Kann man den Aufffangbefehl nicht schon früher setzen?
Josef
Anzeige
AW: Fehler auffangen
WernerB.
Hallo Josef,
und so?

Sub Übertragen_AA() ' Übertrag AA  EPAK
Dim Wert As Variant
Dim iCol, iLZ, ICount, iZ, iR As Integer
Dim C As Range
'Wert = Application.InputBox("AA  EPAK")
Wert = Application.InputBox("Aufforderung:", "Titel", "AA  EPAK")
If Wert = "" Or Wert = False Then
MsgBox "Keine Eingabe !" & vbCr & vbCr & "Makro-Abbruch !", _
vbCritical, "Dezenter Hinweis für " & Application.UserName & ":"
End
End If
For iCol = 1 To 5
If Cells(65536, iCol).End(xlUp).Row > ICount Then
ICount = Cells(65536, iCol).End(xlUp).Row
iLZ = iCol
End If
Next iCol
For iZ = 1 To ICount
With Rows(iZ)
Set C = .Find(What:=Wert, LookAt:=xlPart, SearchOrder:=xlByRows)
If Not C Is Nothing Then
iR = C.Row
With Sheets("Tabelle2")
Range(Cells(iR, 1), Cells(iR, 16)).Copy _
Destination:=.Cells(.Cells(65536, 1).End(xlUp).Row + 1, 1)
End With
Else
MsgBox "AA EPAK wurde nicht gefunden !" & vbCr & vbCr & _
"Makro-Abbruch !", vbCritical, "Dezenter Hinweis für " & _
Application.UserName & ":"
End
End If
End With
Next iZ
End Sub

Gruß
WernerB.
Anzeige
AW: Fehler auffangen
09.12.2004 09:37:07
Josef
Hallo Werner!
Habs getestet. Obwohl AA EPAK vorhanden, wird angezeigt, dass nichts gefunden wurde und der Abbruch erfolgt.
Das Makro ist bereits in der Musterdatei drinnen.
https://www.herber.de/bbs/user/14561.xls
Josef
Josef
AW: Fehler auffangen
WernerB.
Hallo Josef,
wenn ich Dein Problem jetzt richtig erfasst habe, dann sollte es so funktionieren:

Sub Übertragen_AA() ' Übertrag AA  EPAK
Dim C As Range
Dim Wert As Variant
Dim ICount As Long, iZ As Long, iR As Long
Dim iCol As Integer, iLZ As Integer
'Wert = Application.InputBox("AA  EPAK")
Wert = Application.InputBox("Aufforderung:", "Titel", "AA  EPAK")
If Wert = "" Or Wert = False Then
MsgBox "Keine Eingabe !" & vbCr & vbCr & "Makro-Abbruch !", _
vbCritical, "Dezenter Hinweis für " & Application.UserName & ":"
End
End If
For iCol = 1 To 5
If Cells(65536, iCol).End(xlUp).Row > ICount Then
ICount = Cells(65536, iCol).End(xlUp).Row
iLZ = iCol
End If
Next iCol
For iZ = 1 To ICount
With Rows(iZ)
Set C = .Find(What:=Wert, LookAt:=xlPart, SearchOrder:=xlByRows)
If Not C Is Nothing Then
iR = C.Row
Set C = Nothing
With Sheets("Tabelle2")
Range(Cells(iR, 1), Cells(iR, 16)).Copy _
Destination:=.Cells(.Cells(65536, 1).End(xlUp).Row + 1, 1)
End With
End If
End With
Next iZ
If Sheets("Tabelle2").Cells(Rows.Count, 1).End(xlUp).Row = 1 Then
MsgBox "AA EPAK wurde nicht gefunden !" & vbCr & vbCr & _
"Makro-Abbruch !", vbCritical, "Dezenter Hinweis für " & _
Application.UserName & ":"
End
End If
End Sub

Gruß
WernerB.
Anzeige
AW: Fehler auffangen
09.12.2004 12:59:07
Josef
Hallo Werner!
Jetzt glaube ich sollte es funktionieren.
Nach der Makro Abbruch Meldung erhalte ich jedoch noch von Windows die Standardmeldung:
Microsoft kann keine übereinstimmenden Daten finden.....
kann man diese Meldung noch abschalten?
Danke auf jeden Fall für Deine Hilfe.Hast mir sehr geholfen.
Josef
AW: Fehler auffangen
WernerB.
Hallo Josef,
die von Dir angeführte "Windows-Standardmeldung" kenne ich nicht.
Von daher weiß ich auch nicht, wie man sie "abstellt".
Vielleicht machst Du dazu besser einen neuen Thread auf.
Gruß
wernerB.

Links zu Excel-Dialogen

InputBox

Beliebteste Forumthreads (12 Monate)

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

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige