ich habe ein kleines Programm geschrieben, das aus einem Tabellenblatt einzelne Rechnungspositionen in eine Tabelle "Jahresstatistik" einträgt. Normalerweise ist jede Rechnungsposition in der Jahresstatistik schon erfasst. Mein Programm nimmt also eine Rechnungsposition und sucht in der Tabelle Jahresstatistik ob dieser Eintrag schon vorhanden ist, wenn nicht läuft das Programm in eine Fehlerroutine die ich mit On Error goto Errorhandler anspringe. geht das programm in die fehlerroutine, öffnet sich ein Dialogfenster in dem ausgewählt werden kann ob die Position zu einer bereits vorhandenen Rechnungsposition in der Jahresstatistik eingetragen werden soll.
wählt man eine bereits vorhandene Position aus läuft das Programm richtig weiter. Kommt es aber vor, dass es dann nochmals in die Fehlerbehandlung läuft kommt die Fehlermeldung Objektvariable oder With-Blockvariable nicht festgelegt und zwar bei dieser Anweisung
Cells.Find(What:="" & geraet & "", After:=ActiveCell, LookIn:= _
xlFormulas, LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:= _
xlNext, MatchCase:=False).Activate
Der gesamte Code des Makros wäre:
Sub Mietstatistik()
Dim zeil As Long
On Error GoTo Errorhandler
Set Statistik = Workbooks("Jahresstatistik.xls").Sheets(1)
Set Datenblatt = ActiveWorkbook.ActiveSheet
Set Rechnungsprogramm = Workbooks("BMV-Martin 19.07.02.xls").Sheets(1)
zeil = 21
Datenblatt.Activate
Do While Rechnungsprogramm.Range("E" & zeil) <> "Summe Netto"
geraet = Rechnungsprogramm.Range("B" & zeil).Value
Prüftag = (InStr(1, geraet, "Tag"))
Prüfwo = (InStr(1, geraet, "Woche"))
Prüfmon = (InStr(1, geraet, "Monat"))
Prüflit = (InStr(1, geraet, "Liter"))
PrüfAb = (InStr(1, geraet, "mm"))
If Prüftag <> "0" Or Prüfwo <> "0" Or Prüfmon <> "0" Or Prüflit <> "0" Or PrüfAb <> "0" Then
If InStr(1, geraet, "Monat") Then
geraet = Mid(geraet, 8)
ElseIf InStr(1, geraet, "Monate") Then
geraet = Mid(geraet, 9)
ElseIf InStr(1, geraet, "Tage") Then
geraet = Mid(geraet, 7)
ElseIf InStr(1, geraet, "Tag") Then
geraet = Mid(geraet, 6)
ElseIf InStr(1, geraet, "Wochen") Then
geraet = Mid(geraet, 9)
ElseIf InStr(1, geraet, "Woche") Then
geraet = Mid(geraet, 8)
ElseIf InStr(1, geraet, "Liter") Then
geraet = Mid(geraet, 8)
ElseIf InStr(1, geraet, "mm") Then
geraet = Mid(geraet, PrüfAb + 3)
End If
If geraet = "Abnutzung" Or geraet = "Abnutzung " Then GoTo Errorhandler
If geraet = "" Or IsDate(geraet) Or InStr(1, geraet, "bis") Then
Else:
Statistik.Activate
Range("A1").Select
Cells.Find(What:="" & geraet & "", After:=ActiveCell, LookIn:= _
xlFormulas, LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:= _
xlNext, MatchCase:=False).Activate
If ActiveCell.Value <> geraet Then
MsgBox "Kein Gerät gefunden"
Else: ActiveCell.Offset(0, 1).Value = ActiveCell.Offset(0, 1).Value + Rechnungsprogramm.Range("G" & zeil).Value
Datenblatt.Activate
End If
End If
End If
10
zeil = zeil + 1
Loop
Rechnungsprogramm.Activate
Exit Sub
Errorhandler:
Fehlgeraet = geraet
If geraet = "Abnutzung" Or geraet = "Abnutzung " Then
Abgeraetzeilhilf = Rechnungsprogramm.Range("A" & zeil).End(xlUp).Offset(-1, 0).Row - 3
Abgeraetzeil = Rechnungsprogramm.Range("A" & Abgeraetzeilhilf).End(xlDown).Offset(1, 0).Row - 1
Abgeraet = Rechnungsprogramm.Range("B" & Abgeraetzeil).Value
If InStr(1, Abgeraet, "Monat") Then
Abgeraet = Mid(Abgeraet, 8)
ElseIf InStr(1, Abgeraet, "Monate") Then
Abgeraet = Mid(Abgeraet, 9)
ElseIf InStr(1, Abgeraet, "Tage") Then
Abgeraet = Mid(Abgeraet, 7)
ElseIf InStr(1, Abgeraet, "Tag") Then
Abgeraet = Mid(Abgeraet, 6)
ElseIf InStr(1, Abgeraet, "Wochen") Then
Abgeraet = Mid(Abgeraet, 9)
ElseIf InStr(1, Abgeraet, "Woche") Then
Abgeraet = Mid(Abgeraet, 8)
End If
Fehlgeraet = Fehlgeraet + "für " + Abgeraet
End If
Workbooks("Jahresstatistik.xls").Sheets(3).Range("A1").Value = zeil
UserForm1.Show
Fehlgeraet = ""
Rechnungsprogramm.Activate
GoTo 10
End Sub
Kann mir da jemand sagen, warum beim erstmaligem Anlauf der Fehlerroutine alles klappt und dann nicht mehr?
Viele Grüße
Klaus