VBA für Datum und Uhrzeitauflistung (Fortführung), beim öffnen der Arbeitmappe?
Hallo VBA-Profis,
ich hätte gerne (bei Zelle A1 und B1 beginnend) ein VBA, dass beim öffnen der Arbeitsmappe, das Datum und die Uhrzeit sich auflistet, bzw. Fortführt.
D. h. beim 1. öffnen der Arbeitsmappe soll die Zelle A1 mit Datum und B1 mit Uhrzeit versehen werden (ungefähr so siehe Abb.)
Jetzt möchte ich, dass beim 2. öffnen der Arbeitsmappe, die Daten in A1 und B1 bestehen bleiben und das neue Datum und Uhrzeit in A2 (Datum) und B2 (Uhrzeit) eingetragen wird.
Beim 3. öffnen, A3 und A4 aktualisiert wird, u.s.w., aber die vorherigen Daten sollen stets erhalten bleiben.
Gibt es einen Möglichkeit dies stetig fortzuführen, optimal wäre sicherlich die Spalte A und B ohne Begrenzung, außer der möglichen Zeilenmenge-Verfügbarkeit von 1.048.576 Zeilen (so bei EXCEL 2019).
Ich habe keine VBA-Syntax-Kenntnisse !
Freue mich über eine Idee Eurerseits.
Gruß Tron
3 Antworten
Probier es einmal so:
Private Sub Workbook_Open()
If [a1] = "" Then
[a1] = Date
[b1] = Time
ElseIf [a2] = "" Then
[a2] = Date
[b2] = Time
Else
[a1].End(xlDown).Offset(1, 0) = Date
[a1].End(xlDown).Offset(0, 1) = Time
End If
End Sub
In meinem Test funktioniert es erst ab der dritten Zeile.
Ich behaupte nicht, dass man den Code nicht noch optimieren kann.
Probier es einfach aus.
Ich weiß nur, dass die Funktionen abgebildet werden, die man mit der Steuerungstaste und den Pfeiltasten ausführen kann.
Es gibt verschieden Variationen des Befehls. Man kann auch [A9999].End(xlUp) und so weiter ausprobieren.
... Sehe gerade, dass man sich dann das ElseIf sparen könnte.
Dann gibt es noch den UsedRange. Meiner Erinnerung hat man hier nicht viel gewonnen, wenn man diesen nutzt.
Herzlichen Dank für die zeitnahe Rückmeldung !
Funktioniert so wie ich es wollte (Datum in Spalte A, Uhrzeit in Spalte B).
Wollte die Option auf Spalte C erweitern ("UserName") hat aber nur 2x funktioniert, ohne Spalte C.
Dachte es würde so funktionieren (siehe folgend zusammengebastelt).
Private Sub Workbook_Open()
If [a1] = "" Then
[a1] = Date
[b1] = Time
[c1] = UserName
ElseIf [a2] = "" Then
[a2] = Date
[b2] = Time
[c2] = UserName
Else
[a1].End(xlDown).Offset(1, 0, 0) = Date
[a1].End(xlDown).Offset(0, 1, 0) = Time
[a1].End(xlDown).Offset(0, 0, 1) = UserName
End If
End Sub
War aber nicht so !
Woran liegt es.
Offset erwartet 2 Parameter: den Zeilen- und den Spaltenoffset. Das ist die Zahl an Zeilen und Spalten relativ zur Bezugszelle.
Sorry,
hatte das Modul bei "UserName" nicht berücksichtigt, da Tests in anderen Dateien ohne Modul, führten zu unzureichenden Ergebnissen.
Offset habe ich korrigiert, funktioniert jetzt auch auf bestehendes VBA mit anderen Abfragen !
[a1].End(xlDown).Offset(1, 0) = x
[a1].End(xlDown).Offset(0, 1) = xy
[a1].End(xlDown).Offset(0, 2) = xyz
1000 Dank für Deine Bemühungen.
Ist jetzt erledigt !!!
Ja super! Schön das du das Ganze nun rund bekommen hast.
Private Sub Workbook_Open()
Dim LastRow As Long
With ActiveSheet
LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
End With
If LastRow > 1 Then
LastRow = LastRow + 1
End If
Cells(LastRow, 1) = Date
Cells(LastRow + 1, 1) = Time
End Sub
LG
Auch Dir herzlichen Dank für die zeitnahe Rückmeldung !
Funktioniert auch, Datum und Uhrzeit sind allerdings in Spalte A untereinander fortführend.
Eventuell diese Version hilfreich für andere Vorhaben.
Danke !
Private Sub Workbook_Open()
Dim LastRow As Long
With ActiveSheet
LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
End With
If (LastRow > 1) Or Range("A1").Value <> "" Then
LastRow = LastRow + 1
End If
Cells(LastRow, 1) = Date
Cells(LastRow, 2) = Time
End Sub
Sorry, beim 2. Mal habe ich nicht getestet...
.Cells(.Rows.Count, "A").End(xlUp).Row
liefert 1 Wenn die Tabelle Leer ist bzw. wenn nur die 1. Zeile voll ist... Meine Fehler- sorry noch mal. Jetzt sollte es funktionieren....
Hallo,
vielen Dank, habe die Version von "Suboptimierer" realisiert und prämiert.
Sorry, musste jemanden selektieren der als Erstes die Beste Option lieferte und hoffe das Du nicht sauer bist.
Das nächste Mal … .
Dennoch werde ich Deine Version mal Testen, eventuell bieten sich da ganz andere Möglichkeiten.
1000 Dank für Dein Engagement.
Leider bekommt man von Fragestellern nicht immer die Aufmerksamkeit, obwohl man Stunden für die Lösungsfindung verbracht hat.
Einziger Trost ist, das gewisse Fragestellungen einem als Vorteilhaft erschließen, falls es zu ähnliche Situation kommt.
Gruß Tron
Beim 2. Mal habe ich nur das hier hinzugefügt gehabt:
Or Range("A1").Value <> ""
Also nochmal hier die komplette Funktion:
Private Sub Workbook_Open()
Dim LastRow As Long
With ActiveSheet
LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
End With
If (LastRow > 1) Or Range("A1").Value <> "" Then
LastRow = LastRow + 1
End If
Cells(LastRow, 1) = Date
Cells(LastRow, 2) = Time
End Sub
Mir ist es egal ob meine Lösung gewählt wird oder nicht- mir ist es wichtig, das was ich an Lösung bereitstelle soll funktionieren und soll auch korrekt sein- ich kämpfe nicht für die "Hilfreichste Antwort" sondern ich gebe mein Wissen gerne weiter.
Die Antwort von Suboptimierer funktioniert zwar, aber in der Informatikwelt macht man das einfach nicht so... (für die ersten 2 Einträge macht er die Abfrage manuell, und ab dem 3. dann automatisiert- das gehört sich nicht so).
Egal, viel Erfolg! ;)
Nochmals 1000 Dank !!! ;-)
Schade finde ich es, dass manchmal keine Resonanz von Fragestellern erfolgt, obwohl man unter Umständen sehr viel Zeit zur Lösungsfindung verbracht hat.
Ich habe Deine Varianten getestet (nach meinen Bedürfnissen die Abfrage erweitert) und funktionieren beide.
Die 1. Variante verteilt sich in Spalte A (Daten nach unten fortführend) und ist auch Super. Die 2. Variante verteilt sich in den Zeilen (Daten nach unten fortführend).
Ich hätte da noch einen Frage: Wie sieht der Zusatz-Syntax aus wenn das VBA sich nur auf "Tabelle1" (als Beispiel) beziehen darf, denn die Einträge erfolgen auf dem Blatt, wo man sich befindet, bzw. zuletzt befunden hatte (beim öffnen der Datei).
Könnte bei mehr Register sich als unvorteilhaft erweisen.
Private Sub Workbook_Open()
Dim LastRow As Long
ActiveWorkbook.Sheets("Test1").Activate
With ActiveSheet
LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
End With
If (LastRow > 1) Or Range("A1").Value <> "" Then
LastRow = LastRow + 1
End If
Cells(LastRow, 1) = Date
Cells(LastRow, 2) = Time
End Sub
Mit dieser Zeile:
ActiveWorkbook.Sheets("Test1").Activate
bestimmst Du welcher Sheet der "ActiveSheet" sein soll. Also statt "Test1" kannst du sonst was schreiben (auch dynamisch).
Beachte, dass dein Code im Reiter "DieserArbeitsmappe" (auf der linken Seite) eingetragen werden muss.
Ich hoffe, es ist soweit alles verständlich.
LG
Hallo pushido!
Wie bekommst du den VBA-Code so schön formatiert in den thread?
Aha, danke. Aus meinem Excel 2016 ein kleines Makro mit 10 Zeilenkommt so an:
Sub Makro1()
End Sub
End Sub
End Sub
End Sub
End Sub
End Sub
End Sub
End Sub
End Sub
Vielleicht liegt es am Browser, welchen verwendest du?
Ohne VBA kannst du das Datum / die Uhrzeit sehr schnell manuell setzen, ohne sie schreiben zu müssen (auch weil viele Netzwerke kein VBA zulassen):
Shortcut Datum: Strg+Punkt
Shortcut Zeit: Strg+Doppelpunkt
gehen beide auch nacheinander (sinnvollerweise mit Leerzeichen dazwischen) oder einzeln in Fließtexten.
In LO etc geht dieser Shortcut nicht. (oder anders?)
Danke lamiam,
ist mir geläufig, möchte aber aus Sicherheitstechnischen Gründen im Hintergrund die gewünschte Option über VBA laufen lassen, sobald die Datei geöffnet wird.
Hierzu spielen andere Aspekte eine wichtige Rolle.
Gruß Tron
Sieht richtig aus, wofür aber das ElseIf? Funktioniert xlDown nicht bei nur einer Zelle / Zeile?