Wie zwei Private Sub Worksheet_Change zusammen bekommen?

Question

Hallo,

ich hoffe, es kann mir geholfen werden?

wie bekomme diese zwei Private Sub Worksheet_Change in einer Tabelle zusammen. So funktioniert es nicht

Private Sub Worksheet_Change(ByVal r As Range)
s = r.Column
rr = r.Row
If s = 1 Then
Cells(rr, s + 30).Value = Format(Date, "yyyy-mm-dd")

End If
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)

If Not Intersect(Target, Range("A:A")) Is Nothing Then
If Target.Offset(0, -1) <> "" Then Exit Sub
If Target.Address(False, False) = "B1" Then
Range("AI1") = 1
Else
Target.Offset(0, -1) = Application.WorksheetFunction.Max(Range("AI:AI")) + 1
End If
End If
End Sub

Herzlichen Dank im voraus!
Mick

Answer 1

Hallo Mick,

dein zweites Makro kann so nicht funktionieren.
Das Makro wird nur dann ausgelöst, wenn in dem Arbeitsblatt eine Eingabe in Spalte A (= 1. Spalte) gemacht wird. Mit Target.Offset(0,-1) willst du dann eine Spalte nach links gehen (also Spalte 0), die gibt es jedoch nicht und es kommt zu einer Fehlermeldung.
Und auch der Teil mit

If Target.Address(False, False) = "B1" Then

kann nicht funktionieren, da ja der Code nur ausgeführt wird, wenn eine Eingabe in Spalte A erfolgt.

Wenn ich das richtig interpretiere, willst du eine automatische Nummerierung erreichen. Aber in welcher Spalte?
Erkläre doch mal, was genau das Makro tun soll.

Gruß

M.O.

Answer 2

Hallo M.O.,

Danke für Dein Interesse!

Erstes Makro soll unabhängig von der Zeilennummer beim befüllen der Spalte A
in Spalte AI das aktuelle Tagesdatum im Format JJJJ-MM-TT eintragen.
Damit es nicht aktualisiert wird werde ich mir mit dem Makrorekorder, Strg + C und einfügen als Wert aufzeichnen.

Zweites Makro soll wenn in Spalte B etwas eingetragen wird, in Spalte AJ eine feste
fortlaufende Nummer (wie eine eindeutige ID) eingetragen werden, die sich auch nach
dem Sortieren nicht ändert.

Vielen Dank im voraus für Deine (vielleicht?) weitere Hilfe!

MfG
Mick

Answer 3

Hallo,

was evtl. noch erwähnenswert ist, daß Zeilen 1-3 mit Überschriften Belegt sind und
die Eingaben erst ab Zeile 4 beginnen.

Mit freundlichen Grüßen
Mick

Answer 4

Hallo Mick,

versuch mal das folgende Makro:

Private Sub Worksheet_SelectionChange(ByVal Target As Range)

'Prüfen, ob Eingabe in Spalte A erfolgt ist
If Not Intersect(Target, Range("A:A")) Is Nothing Then
If Target.Row > 3 Then 'nur wenn ab Zeile 4 etwas eingegeben wurde
With Cells(Target.Row, 35)
.Value = Date 'dann in Spalte AI das Datum einfügen
.NumberFormat = "YYYY.MM.DD" 'und formatieren
End With
End If
End If

'nun für Spalte B
If Not Intersect(Target, Range("B:B")) Is Nothing Then
If Target.Row > 3 Then
'prüfen, ob in Spalte AJ die betreffende Zelle leer ist und falls ja, dann neue Nummer einfügen,
If IsEmpty(Cells(Target.Row, 36)) = True Then Cells(Target.Row, 36) = Application.WorksheetFunction.Max(Range("AJ:AJ")) + 1
End If
End If

End Sub

Gruß

M.O.

Answer 5

Guten Abend M.O.,

vielen Dank für Deine geopferte Zeit!
Es funktioniert prima :) Jetzt kann ich mit dem befüllen der Tabelle anfangen.

Einen schönen Abend noch und freundliche Grüsse
Mick

Answer 6

Hallo Mick,

danke für die Rückmeldung.

Gruß

M.O.

Answer 7

Hallo M.O.,

könnte man das mit der Spalte A nochmal etwas abändern?

Ich habe das Problem, daß wenn ich auf eine Zelle in Spalte A klicke,
das Datum schon eingefügt wird ohne etwas reingeschrieben zu haben.

Ist es machbar daß das Datum erst nach Prüfung ob in entsprechender Zelle
schon ein Datum steht, wenn ja dann nichts tun, wenn nein dann erst wenn Zelle in
Spalte A befüllt wurde, eingetragen wird?

Internette Grüsse
Mick

Answer 8

Hallo Mick,

meinst du das etwa so:

Private Sub Worksheet_Change(ByVal Target As Range)
'Prüfen, ob Eingabe in Spalte A erfolgt ist
If Not Intersect(Target, Range("A:A")) Is Nothing Then
If Target.Row > 3 Then 'nur wenn ab Zeile 4 etwas eingegeben wurde
If IsEmpty(Cells(Target.Row, 1)) = False And IsEmpty(Cells(Target.Row, 35)) = True Then 'Prüfen, ob Eingabe in Spalte A erfolgt ist und Spalte AI leer ist
With Cells(Target.Row, 35)
.Value = Date 'dann in Spalte AI das Datum einfügen
.NumberFormat = "YYYY.MM.DD" 'und formatieren
End With
End If
End If
End If

'nun für Spalte B
If Not Intersect(Target, Range("B:B")) Is Nothing Then
If Target.Row > 3 Then
'prüfen, ob eine Eingabe in Spalte B erfolgt ist und ob in Spalte AJ die betreffende Zelle leer ist und falls ja, dann neue Nummer einfügen,
If IsEmpty(Cells(Target.Row, 2)) = False And IsEmpty(Cells(Target.Row, 36)) = True Then Cells(Target.Row, 36) = Application.WorksheetFunction.Max(Range("AJ:AJ")) + 1
End If
End If

End Sub

Ich habe das Makro so angepasst, dass auch die Nummer erst eingefügt wird, wenn eine Eingabe in Spalte B erfolgt.
Beachte bitte, dass hier jetzt das Worksheet-Change-Ereignis genutzt wird (also bitte altes Makro löschen und das neue Makro in das VBA-Projekt deines Arbeitsblatts einfügen).

Gruß

M.O.

Answer 9

Hallo M.O.,

entschuldige für das späte Antworten!
Das Makro funktioniert nun so, wie ich es mir gewünscht hatte :)

Internette Grüsse
Mick