Office: (Office 2007) Zellenautofill Makro stürzt ab, nach neuer Zeile einfügen

Hi,

ich habe ein Makro zur Verfügung gestellt bekommen, welches dafür sorgt, dass wenn ich etwas in Spalte E ab Zeile 2 eintrage 4 Spalten weiter das Datum automatisch erscheint und 5 Zeilen weiter der Username. Das Makro läuft nicht als Modul. Ich habe es direkt über VBA zur Tabelle zugewiesen.
Nun ist das Problem, wenn ich eine Zeile einfüge, kommt eine Fehlermeldung und das Makro funktioniert nicht mehr. WEiß jemand wo der Fehler ist?

Private Sub Worksheet_Change(ByVal Target As Range)

Dim Zelle As Range
Dim Zeilen As String

Zeilen = Selection.Rows.Count

If Intersect(Target, Range("E2:E65536")) Is Nothing Then Exit Sub

Application.EnableEvents = False

If Zeilen = 1 Then
If Target.Value <> "" Then
If Target.Offset(0, 4).Value = "" Then
Target.Offset(0, 4).Value = Now
Target.Offset(0, 5).Value = Application.UserName
Else
End If
Else
Target.Offset(0, 4).Value = ""
Target.Offset(0, 4).Value = ""
Target.Offset(0, 5).Value = ""
End If
ElseIf Zeilen > 1 Then
For Each Zelle In Selection
Zelle.Offset(0, 4).Value = ""
Zelle.Offset(0, 4).Value = ""
Zelle.Offset(0, 5).Value = ""
Next Zelle
End If

Application.EnableEvents = True

End Sub

 

Hi,

der Fehler tritt auf, weil Zeilen mehr als nur 1 Zelle umfassen, mit Target jedoch immer nur 1 Zelle angesprochen wird - ergo: Fehlermeldung. Schreibe anstelle Target.Offset(...).Value dieses: Target.Cells(1).Offset(...).Value, dann wird nur die 1. (und damit nur 1) Zelle angesprochen.

Noch ein Hinweis: mit Intersect(Target, Range("E2:E65536")) reagiert dein Code ab Excel2007 nicht mehr, wenn du dich in einer Zeile unterhalb Zeile 65536 befindest. Möglicherweis wird dies niemals der Fall sein, dennoch würde ich stattdessen folgendes schreiben um sicher zu gehen:

Code:

If Intersect(Target, Columns(5)) Is Nothing Or Target.Row < 2 Then Exit Sub

Weiter unten in deinem Code steht an 2 Stellen

Code:

[COLOR=#ff0000]Target.Offset(0, 4).Value = ""[/COLOR]
[COLOR=#ff0000]Target.Offset(0, 4).Value = ""[/COLOR]
Target.Offset(0, 5).Value = ""

Das ist doppelt-gemoppelt


Bis später,
Karin

 

Hi Karin,

vielen Dank für deine Hilfe. Ich habe es ausprobiert und alles ist wie gehabt. Das Makro selber funktioniert, aber sobald ich eine neue Zeile hinzufüge kommt wieder die Fehlermeldung. Beim Debuggen meint VBA, dass der Fehler hier liegt:

If Target.Value <> "" Then


VG
Tobi

 

Hi Tobi,

du musst den Achrivthread verlinken und nicht den zum Forum allgemein.

Wann genau kommt denn der Fehler und welcher (was sagt der Debugger genau)?


Bis später,
Karin

 

Hi,

hier noch der richtige Link, sorry:
http://www.herber.de/forum/messages/1565768.html

Wenn du z.B. eine neue Tabelle nimmst oder auch eine vorhandene und dann alles bei VBA eintippst, läuft soweit alles tadellos. Ich kann etwas in Spalte E eintippen und 4 Spalten weiter erscheint das Datum und eine davon weiter der Benutzername. Es funktioniert auch alles wunderbar mit deinen Änderungen.
Sobald ich aber bei Excel eine neue Zeile hinzufüge tritt dieser Fehler auf: Laufzeitfehler '13' Typen unverträglich. Der Debugger markiert dann noch genannte Zeile.

VG

 

Hi,

das kann ich nicht nachvollziehen. Lade doch mal eine Beispielmappe hoch.

Bis später,
Karin

 

Hier ist mal die kleinste Vorlage. Den Anhang Beispiel Prüfvermerk.xlsm betrachten

 

Dass Excel abstürzt liegt an deiner Schleife For Each Zelle In Selection, denn es wird jede Zelle der selektierten (und eignefügten) Zeilen durchlaufen.

Wenn ich deinen Code richtig interpretiere, sollte das, was du erreichen willst, mit folgendem Code möglich sein:

Code:

Application.EnableEvents = False
For Each Target In Intersect(Target, Columns(5))
    If Target <> "" Then
        If Target.Offset(0, 4).Value = "" Then
            Target.Offset(0, 4).Value = Now
            Target.Offset(0, 5).Value = Application.UserName
        End If
    Else
        If Selection.Cells.Count = Selection.Rows.Count Then
            Target.Offset(0, 4).Value = ""
            Target.Offset(0, 5).Value = ""
        End If
    End If
Next Target
Application.EnableEvents = True

Bis später,
Karin

 

Hat perfekt geklappt. Vielen lieben Dank, jetzt hab' ich endlich wieder den Kopf frei für die anderen Probleme :D.
Riesendank nochmal, bin gerade wahnsinnig glücklich.

 

Hi Karin,

sorry aber mir ist nun doch eine Kleinigkeit aufgefallen. Jetzt meckert der Debugger rum, wenn ich einen Wert irgend woanders eintrage. Leider muss ich auch in anderen Spalten Werte und Formeln eintragen.
Dafür war glaube ich:

Is Nothing Then Exit Sub

Ich schau mal, was ich da machen kann, aber bisher konnte ich das nun wieder nicht beheben

 

Ich hab jetzt mal den alten Code mit deinen gemixt. Die Schleife ist raus, aber es ist wieder der Alte Fehler vorhanden: (Ich hab mal die vom Debugger markierte Zeile hervorgehoben)

Code:

Private Sub Worksheet_Change(ByVal Target As Range)

Application.EnableEvents = False
If Intersect(Target, Columns(5)) Is Nothing Or Target.Row < 2 Then Exit Sub
    [B][U]If Target <> "" Then[/U][/B]
        If Target.Offset(0, 4).Value = "" Then
            Target.Offset(0, 4).Value = Now
            Target.Offset(0, 5).Value = Application.UserName
        End If
    Else
        If Selection.Cells.Count = Selection.Rows.Count Then
            Target.Offset(0, 4).Value = ""
            Target.Offset(0, 5).Value = ""
        End If
    End If
Application.EnableEvents = True

End Sub

 

Hi,

ich habe nicht den kompletten Code sondern nur den Teil gepostet, der zwischen den beiden Zeilen mit Application.EnableEvents steht - die Zeile mit Intersect muss natürlich bleiben, damit der Code nur in Spalte E ab Zeile 2 reagiert.

Bis später,
Karin

 

Das ist nicht mein kompletter Code.

Bis später,
Karin

 

Achso, ja klar. Blöd von mir :D.
Danke für deine Geduld. Nun klappt wirklich alles :).

VG
Tobi