Fehlermeldung bei Makro

Sub Main() Dim lngLastRow As Long Dim strTMP As String On Error GoTo Fin With Tabelle1 lngLastRow = .Cells(.Rows.Count, 2).End(xlUp).Row strTMP = Split(Split(.Cells(lngLastRow, 2).Value, "(")(1), ")")(0) If Left(strTMP, 2) = "00" Then strTMP = "00" & strTMP + 1 ElseIf Left(strTMP, 1) = 0 Then strTMP = "0" & strTMP + 1 Else strTMP = strTMP + 1 End If If Len(strTMP) > 3 Then strTMP = Right(strTMP, 3) .Cells(lngLastRow + 1, 2).Value = "(" & strTMP & ")_ " Application.Goto .Cells(lngLastRow + 1, 2), True SendKeys "{F2}" End With Fin: If Err.Number 0 Then MsgBox "Error: " & _ Err.Number & " " & Err.Description End Sub

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Sub Main() Dim lngLastRow As Long Dim strTMP As String Dim i As Long On Error GoTo Fin With Tabelle1 lngLastRow = .Cells(.Rows.Count, 2).End(xlUp).Row For i = lngLastRow To 1 Step -1 If InStr(1, .Cells(i, 2), "(") 0 Then Exit For Next i i = i + 1 .Rows(i).Insert lngLastRow = i - 1 strTMP = Split(Split(.Cells(lngLastRow, 2).Value, "(")(1), ")")(0) If Left(strTMP, 2) = "00" Then strTMP = "00" & strTMP + 1 ElseIf Left(strTMP, 1) = 0 Then strTMP = "0" & strTMP + 1 Else strTMP = strTMP + 1 End If If Len(strTMP) > 3 Then strTMP = Right(strTMP, 3) .Cells(lngLastRow + 1, 2).Value = "(" & strTMP & ")_ " Application.Goto .Cells(lngLastRow + 1, 2), True SendKeys "{F2}" End With Fin: If Err.Number 0 Then MsgBox "Error: " & _ Err.Number & " " & Err.Description End Sub

Ok, ich hab sie einfach in eckige Klammern gesetzt !
Das funktioniert jetzt genau so, wie ich es mir vorgestellt habe !
Nur eine Sache noch !
Wenn ich das Makro ausführe, bekomme ich den
"Lauftzeitfehler '1004': Die Methode 'Undo' für das Objekt '_Application' ist fehlgeschlagen."
Das kann ich aber einfach beenden, ohne es zu debuggen, und dann funktioniert das Makro ganz normal.
Außerdem tritt der Fehler "Laufzeitfehler '424': Objekt erforderlich" auf, wenn ich manuell eine neue zeile einfüge. Auch das kann ich beenden und danach normal ausführen.
Hier werde ich auf "AlterWert = target.Value" im Code hingewiesen.
Wenn ich debugge, weißt der auf meinen Code in der Arbeitsmappe hin. Ich habe mir ein Protokoll erstellt, der alle Änderungen aufnimmt.
Das ist der Code:

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
Dim ErsteFreieZeile As Long
Dim AlterWert As Variant, NeuerWert As Variant
Dim rngNeuSel As Range
If Sh.Name = "Protokoll" Then Exit Sub
If Intersect(Target, Sh.Range("A1:AN2000")) Is Nothing Then Exit Sub
'Ereignisbehandlung ausschalten:
Application.EnableEvents = False
'Zwischenspeichern des neuen Wertes und der neuen Zellmarkierung
NeuerWert = Target.Value
Set rngNeuSel = Selection
'Rückgängigmachen der letzten Aktion (=Zellwertänderung und Zellmarkierung):
Application.Undo '

Sub Main() Dim lngLastRow As Long Dim strTMP As String Dim i As Long On Error GoTo Fin With Tabelle1 lngLastRow = .Cells(.Rows.Count, 2).End(xlUp).Row For i = lngLastRow To 1 Step -1 If InStr(1, .Cells(i, 2), "(") 0 And _ IsNumeric(Mid(.Cells(i, 2), InStr(1, .Cells(i, 2), "(") + 1, 1)) Then Exit For Next i i = i + 1 .Rows(i).Insert lngLastRow = i - 1 strTMP = Split(Split(.Cells(lngLastRow, 2).Value, "(")(1), ")")(0) If Left(strTMP, 2) = "00" Then strTMP = "00" & strTMP + 1 ElseIf Left(strTMP, 1) = 0 Then strTMP = "0" & strTMP + 1 Else strTMP = strTMP + 1 End If If Len(strTMP) > 3 Then strTMP = Right(strTMP, 3) .Cells(lngLastRow + 1, 2).Value = "(" & strTMP & ")_ " Application.Goto .Cells(lngLastRow + 1, 2), True SendKeys "{F2}" End With Fin: If Err.Number 0 Then MsgBox "Error: " & _ Err.Number & " " & Err.Description End Sub

Beliebteste Forumthreads (12 Monate)

15 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

15
Beiträge zum Forumthread

Beiträge zu diesem Forumthread