Live-Forum - Die aktuellen Beiträge
Anzeige
Archiv - Navigation
1900to1904
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

Datumsbereich untereinander schreiben

Datumsbereich untereinander schreiben
17.10.2022 18:32:47
Henry
Hallo liebes Forum,
ich habe ein Problem mit meiner Userform.
Leider habe ich hierfür auch keinen passenden Lösungsansatz im Internet gefunden.
Zu meinem Problem:
Ich habe eine Userform mit zwei Textboxen, in diese Datumsbereiche "von" "bis" eingetragen werden sollen.
Über das Kombinationsfeld kann A oder B ausgewählt werden.
Beim Betätigen des Buttons soll meine Tabelle1 gefüllt werden.
Angenommen:
Der User gibt im ersten Textfeld 17.10.2022 ein und im zweiten Textfeld 20.10.2022 und im Kombinationsfeld wählt er "A".
Dann sollen die Daten wie folgt übertragen werden.
Spalte A
17.10.2022
18.10.2022
19.10.2022
20.10.2022
Spalte B
A
A
A
A
Es soll also der Datumsbereich erkannt werden und fortlaufend untereinander geschrieben werden.
Ich habe hierzu mal eine Beispieldatei angehangen.
Ich würde mich riesig freuen, wenn mir jemand mit meinem Problem helfen kann.
https://www.herber.de/bbs/user/155720.xlsm

17
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Datumsbereich untereinander schreiben
17.10.2022 18:52:09
ralf_b
der Code schreibt den Datumsbereich ab der ersten leeren Zelle in Spalte A

Private Sub CommandButton1_Click()
Dim lastcellA&, i&, cnt&
lastcellA = Cells(Rows.Count, "A").End(xlUp).Row
If Not IsDate(TextBox1) Then Exit Sub
If Not IsDate(TextBox2) Then Exit Sub
For i = CDate(TextBox1) To CDate(TextBox2)
Cells(lastcellA + cnt, "A") = CDate(i)
Cells(lastcellA + cnt, "B") = ComboBox1
cnt = cnt + 1
Next
End Sub

AW: Datumsbereich untereinander schreiben
17.10.2022 19:07:18
Henry
Hallo Ralf,
vielen Dank für deine Hilfe.
Der Code klappt schon mal sehr gut.
Ist es möglich den Code noch so anzupassen, dass der Wert aus der ComboBox ausgelesen wird?
Ich habe versucht den Code wie folgt anzupassen, aber es werden nicht das A oder B in die Zellen geschrieben.

Private Sub CommandButton1_Click()
Dim lastcellA&, i&, cnt&
lastcellA = Cells(Rows.Count, "A").End(xlUp).Row + 1
If Not IsDate(TextBox1) Then Exit Sub
If Not IsDate(TextBox2) Then Exit Sub
Nummer = ComboBox1.Value
For i = CDate(TextBox1) To CDate(TextBox2)
Cells(lastcellA + cnt, Nummer) = CDate(i)
cnt = cnt + 1
Next
End Sub

Anzeige
AW: Datumsbereich untereinander schreiben
17.10.2022 19:51:29
ralf_b
ich verstehe nicht was du meinst.
Wozu den Wert der Combobox auslesen wenn du ihn nicht anderweitig verwendest.
da wo du "Nummer" reingeschrieben hast, wird die Spalte zum Einfügen gewählt. Das habe ich so gemacht ,damit du verstehst in welcher Spalte die Werte reingeschrieben werden. Cells(lastcellA + cnt, 1) und Cells(lastcellA + cnt, 2) wäre da nicht so deutlich.
Also welche neuen Anforderungen warten jetzt auf uns? Deine Eingangsfrage ist ja vollständig beantwortet.
AW: Datumsbereich untereinander schreiben
17.10.2022 22:01:46
Henry
Hallo Ralf,
ich verzweifle an meinem Code. :-(
Ich möchte Abwesenheiten in einer Datenbank pflegen.
Aber es klappt einfach nicht wie es mir vorstelle.
Wenn ich zum ersten Mal einen Datensatz in der Userform eingebe, der nach dem Datum des letzten Eintrags in der Datenbank ist, klappt alles einwandfrei,
Wenn ich den gleich Datensatz aber mit einer anderen Abwesenheit speichere, überschreibt mir der Code die Zeilen.
Ich möchte aber dass der Datensatz angefügt wird. Bzw. korrekt innerhalb der Zeilen angeordnet wird.
Vielleicht kannst du mir nochmal helfen.
Hier findest du den Code:

Private Sub but_abwesenheit_Click()
Dim Zeile As Integer
Dim LetzteZeile As Integer
Dim datum As Date
If cmb_alias.ListIndex = -1 Then
MsgBox "Bitte tragen Sie einen Aliasnamen ein.", vbCritical, "Hinweis"
Exit Sub
ElseIf cmb_abwesenheitsart.ListIndex = -1 Then
MsgBox "Bitte tragen Sie eine Abwesenheitsart ein.", vbCritical, "Hinweis"
Exit Sub
ElseIf txt_datumstart = "" Then
MsgBox "Bitte tragen Sie ein Startdatum ein.", vbCritical, "Hinweis"
Exit Sub
ElseIf txt_datumende = "" Then
MsgBox "Bitte tragen Sie ein Enddatum ein.", vbCritical, "Hinweis"
Exit Sub
End If
datum = txt_datumstart
With Worksheets("datenbank")
Zeile = 2
Do While .Cells(Zeile, 1).Value  ""
If .Cells(Zeile, 1).Value = datum _
And .Cells(Zeile, 5).Value = cmb_alias _
And .Cells(Zeile, 11).Value = cmb_abwesenheitsart Then
MsgBox "Die Abwesenheit wurde bereits gespeichert.", vbCritical, "Hinweis"
Exit Sub
ElseIf .Cells(Zeile, 1).Value > datum Then
Exit Do
End If
Zeile = Zeile + 1
Loop
LetzteZeile = .Cells(Rows.Count, 1).End(xlUp).Row
If Zeile 

Anzeige
AW: Datumsbereich untereinander schreiben
18.10.2022 00:53:01
ralf_b
das kommt davon wenn man die falschen Fragen stellt und nur halbe Informationen bereitstellt.
Mein Code trägt einen Datumsbereich ans Ende einer Liste ein und setzt daneben einen Buchstaben. Mehr nicht.
Du willst aber auch vorhandene Einträge überschreiben.
Dein jetziger Code beinhaltet bisher unbekannte Control-Bezeichnungen, die in der Beispieldatei nicht vorkommen.
Erwartest du tatsächlich das ich das jetzt umbaue damit es in der Beispieldatei funktioniert?
Dein Code ist nicht dokumentiert. Wie soll ich denn wissen ob das was dort passiert auch so von dir beabsichtigt ist?
Vielleicht fängst du nochmal von vorne an.
Anzeige
AW: Datumsbereich untereinander schreiben
18.10.2022 08:24:00
GerdL
Ich möchte aber dass der Datensatz angefügt wird. Bzw. korrekt innerhalb der Zeilen angeordnet wird.
Moin,
heißt das, bei bereits bestehendem Datum in der Tabelle soll der Comboboxtext in die nächsten leere Spalte hinter B, also in die Spalte C
oder ist der bestehenden Eintrag in Spalte B zu überschrieben
oder wie?
Gruß Gerd
AW: Datumsbereich untereinander schreiben
18.10.2022 09:18:22
Henry
Guten Morgen Gerd,
Angenommen in der Tabelle steht:
Spalte A
17.10.2022
18.10.2022
19.10.2022
Spalte B
A
A
A
Nun gibt der User den Datumsbreich 17.10.2022 bis 19.10.2022 an und wählt in der ComboBox "B" aus.
Dann soll der Datensatz wie folgt abgespeichert werden.
Spalte A
17.10.2022
17.10.2022
18.10.2022
18.10.2022
19.10.2022
19.10.2022
Spalte B
A
B
A
B
A
B
Anzeige
AW: Datumsbereich untereinander schreiben
18.10.2022 11:49:20
Daniel
Hi
gibt da mehrere Möglichkeiten.
Programmierer machen das eher so:

Private Sub CommandButton1_Click()
Dim DatVon As Date
Dim DatBis As Date
Dim i
Dim arr
If IsDate(TextBox1.Text) And IsDate(TextBox2.Text) And ComboBox1.Value  "" Then
DatVon = CDate(TextBox1.Text)
DatBis = CDate(TextBox2.Text)
ReDim arr(DatVon To DatBis, 1 To 2)
For i = DatVon To DatBis
arr(i, 1) = i
arr(i, 2) = ComboBox1.Value
Next
Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Resize(DatBis - DatVon + 1, 2) = arr
Cells(1, 1).CurrentRegion.Sort Key1:=Cells(1, 1), order1:=xlAscending, Header:=xlYes
Else
MsgBox "Bitte alles ausfüllen"
End If
End Sub
Excelaffine Menschen könnten das bevorzugen:

Private Sub CommandButton1_Click()
Dim DatVon As Date
Dim DatBis As Date
Dim i
Dim arr
If IsDate(TextBox1.Text) And IsDate(TextBox2.Text) And ComboBox1.Value  "" Then
DatVon = CDate(TextBox1.Text)
DatBis = CDate(TextBox2.Text)
With Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Resize(DatBis - DatVon + 1, 2)
.Columns(2).Value = ComboBox1.Value
.Cells(1, 1).Value = DatVon
.Columns(1).DataSeries Rowcol:=xlColumns, Type:=xlChronological, Date:=xlDay, Step:=1, Trend:=False
End With
Cells(1, 1).CurrentRegion.Sort Key1:=Cells(1, 1), order1:=xlAscending, Header:=xlYes
Else
MsgBox "Bitte alles ausfüllen"
End If
End Sub
Gruß Daniel
Anzeige
AW: Datumsbereich untereinander schreiben
18.10.2022 12:09:38
Henry
Hallo Daniel,
das klappt perfekt!
Vielen lieben Dank. :-)
Kann man eigentlich auch noch eine Prüfung einbauen und prüfen, ob der Datensatz bereits abgespeichert wurde?
Oder ist soetwas eher nicht umsetzbar?
AW: Datumsbereich untereinander schreiben
18.10.2022 12:37:46
Daniel
du meinst, dass die Kombination aus Datum und Buchstabe nicht doppelt vorkommt?
man könnte hinterher ein Duplikate-Entfernen mit der ganzen Tabelle ausführen.
Dabei würden dann die neu hinzugefügten Zeilen gelöscht, wenn sie in der Ausgangstabelle bereits vorhanden sind.
oder man schreibt die Werte direkt in die Tabelle und prüft vorher, ob sie nicht schon drin sind:

For i = DatVon To DatBis
if worksheetfunction.countif(columns(1), i, columns(2), Combobox1.value) = 0 then
with Cells(rows.count, 1).end(xlup)
.offset(1, 0) = i
.offset(1, 1) = Combobox1.value
end with
end if
Next
ist zwar etwas langsamer als die anderen Varianten, aber wenn du so nicht tausende von Tagen einfügst sondern nur ein paar, sollte das nicht spürbar sein.
Gruß Daniel
Anzeige
AW: Fehlerteufelchen
18.10.2022 14:12:40
GerdL
Besser CountIfs statt Countif.
Countif (Zählenwenn) lässt nur zwei Argumente zu. Countifs(Zählenwenns) dagegen Kriterien für mehrere Spalten.
Da hat der Kollege eine erforderliche Kleinigkeit vergessen.
Gruß Gerd
AW: Fehlerteufelchen
18.10.2022 15:36:22
Henry
Hallo Gerd, hallo Daniel,
erst einmal möchte ich mich bei euch bedanken, dass ihr mir immer helft.
Ihr seid echt klasse!
Ich habe von Daniel folgenden Code erhalten, um die Einträge in die Excel Tabelle abzuspeichern.
Der Code klappt perfekt!

Private Sub CommandButton1_Click()
Dim DatVon As Date
Dim DatBis As Date
Dim i
Dim arr
If IsDate(TextBox1.Text) And IsDate(TextBox2.Text) And ComboBox1.Value  "" Then
DatVon = CDate(TextBox1.Text)
DatBis = CDate(TextBox2.Text)
ReDim arr(DatVon To DatBis, 1 To 2)
For i = DatVon To DatBis
arr(i, 1) = i
arr(i, 2) = ComboBox1.Value
Next
Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Resize(DatBis - DatVon + 1, 2) = arr
Cells(1, 1).CurrentRegion.Sort Key1:=Cells(1, 1), order1:=xlAscending, Header:=xlYes
Else
MsgBox "Bitte alles ausfüllen"
End If
End Sub
Mir ist allerdings nicht ganz klar wo ich diesen Codeabschnitt von Daniel unterbringen soll für die Prüfung.
Ich möchte das eine MsgBox Meldung erscheint, wenn der User versucht über den Button den gleichen Eintrag nochmal zu speichern.
For i = DatVon To DatBis
if worksheetfunction.countifs(columns(1), i, columns(2), Combobox1.value) = 0 then
with Cells(rows.count, 1).end(xlup)
.offset(1, 0) = i
.offset(1, 1) = Combobox1.value
end with
end if
Next
Anzeige
AW: Fehlerteufelchen
18.10.2022 15:59:33
Daniel
Hi
die neue For-Schleife ersetzt den Code von ReDim bis Cells(...).Resize(...) = arr jeweils einschließlich dieser Zeilen.
wenn du bei einer Doppelten Eingabe eine Meldung haben willst, dann könntest du einen Else-Teil aufmachen, dann bekommst du aber bei jedem Datum eine Meldung:

For i = DatVon To DatBis
if worksheetfunction.countifs(columns(1), i, columns(2), Combobox1.value) = 0 then
with Cells(rows.count, 1).end(xlup)
.offset(1, 0) = i
.offset(1, 1) = Combobox1.value
end with
Else
Msgbox
end if
Next
wenn du vorab eine Prüfung machen willst, könntest du das auch mit Countifs machen:

if Worksheetfunction.Countifs(Columns(1), ">=" & Clng(DatAb), Columns(1), " 0 then
Msgbox "Datumsbereich mit Text zumindest teilweise schon vorhanden"
else
... hier dann der weitere Code zum einfügen der Daten
end if
am vom mir gewählten Meldungstext kannst du vielleicht erkennen, wo hier das problem liegt, nämlich das es sein kann, dass der neu gewählte Datumsbereich teileweise vorhanden sein kann, dh es gibt Datumswerte, die schon da sind und welche die noch nicht da sind und angelegt werden müssen.
Die Frage ist, was dann passieren soll.
Gruß Daniel
Anzeige
AW: Fehlerteufelchen
18.10.2022 16:24:33
Henry
Hallo Daniel,
danke für die Ausführlichen Erläuterungen. :-)
Das hilft mir sehr weiter.
Ich habe noch versucht eine Prüfung reinzubringen, dass das Datum in TextBox2 immer größer/gleich dem Datum in der TextBox1 sein muss.
Zwar klappt die MsgBox Meldung bei der falschen Eingabe.
Allerdings wird bei einer richtigen Eingabe nun der Datensatz nicht mehr in der Tabelle abgespeichert.
Was mache ich falsch?
Mein Code sieht so aus:

Private Sub CommandButton1_Click()
Dim DatVon As Date
Dim DatBis As Date
Dim i
Dim arr
If IsDate(TextBox1.Text) And IsDate(TextBox2.Text) And ComboBox1.Value  "" Then
DatVon = CDate(TextBox1.Text)
DatBis = CDate(TextBox2.Text)
If CDate(TextBox2.Text) 

Anzeige
AW: Fehlerteufelchen
18.10.2022 16:28:06
Daniel
kannst du bitte den Code mit Einrückungen schreiben und hier einstellen?
wenn den Codetext im Forumseditor markierst und den Butten Code&ltpre&gt&ltcode&gt klickst, dann bleiben die Einrückungen erhalten.
es ist dann leichter, deinen Code zu lesen, wenn man die Einrückungen (die du hoffentlich machst) sieht.
Wenn du bisher keine Einrückungen gemacht hast, mach sie, vielleicht fällt dir dann dein Fehler selber auf.
Gruß Daniel
AW: Fehlerteufelchen
18.10.2022 16:35:39
Henry
Hallo Daniel,
du hast Recht. Das einrücken hat geholfen.
Ich habe den Fehler direkt gefunden. :-)
VG
Henry

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige