Live-Forum - Die aktuellen Beiträge
Datum
Titel
28.03.2024 21:12:36
28.03.2024 18:31:49
Anzeige
Archiv - Navigation
1528to1532
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

TextBox als Datumsformat wird nicht berechnet

TextBox als Datumsformat wird nicht berechnet
19.12.2016 13:29:20
Andi
Hallo,
habe folgendes Problem, über eine Useform werden Verbräuche eingetragen und berechnet
In Spalte A wird ein Datum eingetragen, diese verwende ich wiederum um in der Tabelle die Monatsverbräuche zu berechenen.
Das Funktioniert nur wenn ich nachtäglich das Datum mit der Tastatur in der Zelle eingebe, ansonsten habe ich zwar das Datumsformat aber nicht eine Zahl.
Daher berechnet er mir auch nicht die Monatsverbräuche.
Währe Super wenn Ihr eine Lösung für mich hättet
Vielen Dank im vorraus!
Das ist de ganze VBA-Code von der Userform
Neuer Eintrag Schaltfläche Ereignisroutine
Private Sub CommandButton1_Click()
Dim lZeile As Long
lZeile = Cells(Rows.Count, 1).End(xlUp).Row
lZeile = 4
Do While Trim(CStr(Tabelle2.Cells(lZeile, 1).Value))  ""
lZeile = lZeile + 1 'Nächste Zeile bearbeiten
Loop
Tabelle2.Cells(lZeile, 1) = Format(CDate(Date), "DD.MM.YYYY")
ListBox1.AddItem CDate(Date)
ListBox1.ListIndex = ListBox1.ListCount - 1
End Sub
'Löschen Schaltfläche Ereignisroutine
Private Sub CommandButton2_Click()
Dim lZeile As Long
lZeile = Cells(Rows.Count, 1).End(xlUp).Row
If ListBox1.ListIndex = -1 Then Exit Sub
lZeile = 4
Do While Trim(CStr(Tabelle2.Cells(lZeile, 1).Value))  ""
If ListBox1.Text = Trim(CStr(Tabelle2.Cells(lZeile, 1).Value)) Then
'Eintrag gefunden, die ganze Zeile wird nun gelöscht
Tabelle2.Rows(CStr(lZeile & ":" & lZeile)).Delete
'Die ListBox muss nun neu geladen werden!
Call UserForm_Initialize
If ListBox1.ListCount > 0 Then ListBox1.ListIndex = 0
Exit Do 'Vorzeitiges Ende, da der Datensatz schon gefunden ist
End If
lZeile = lZeile + 1 'Nächste Zeile bearbeiten
Loop
End Sub

Private Sub CommandButton3_Click()
Dim lZeile As Long
Dim i As Integer
On Error GoTo ErrExit
With Application
.ScreenUpdating = False
.EnableEvents = False
.Calculation = xlManual
.DisplayAlerts = False
End With
lZeile = Cells(Rows.Count, 1).End(xlUp).Row
If ListBox1.ListIndex > -1 And Trim(TextBox1.Text)  "" Then
lZeile = 4
With Tabelle2
Do While Trim(CDate(.Cells(lZeile, 1).Value))  ""
If ListBox1.Text = Trim(CDate(.Cells(lZeile, 1).Value)) Then
.Rows(lZeile).Font.Bold = Day(CDate(TextBox1.Text)) = 1
If IsDate(TextBox1.Text) Then .Cells(lZeile, 1).Value = Format(Trim(CDate(TextBox1.Text) _
), "DD.MM.YYYY")
.Cells(lZeile, 1).Value = Format(CDate(Trim(TextBox1.Text)), "DD.MM.YYYY")
.Cells(lZeile, 1) = Format(.Cells(lZeile, 1).Value, "DD.MM.YYYY")
If IsNumeric(TextBox2.Text) Then .Cells(lZeile, 2).Value = CDbl(TextBox2.Text)
TextBox3.Value = .Cells(lZeile, 2).Value - .Cells(lZeile - 1, 2).Value
If IsNumeric(TextBox3.Text) Then .Cells(lZeile, 3).Value = CDbl(TextBox3.Text)
.Cells(lZeile, 4).Value = Format(TextBox4.Text, "0 °C")
If IsNumeric(TextBox5.Text) Then .Cells(lZeile, 5).Value = CDbl(TextBox5.Text)
TextBox6.Value = .Cells(lZeile, 5).Value - .Cells(lZeile - 1, 5).Value
If IsNumeric(TextBox6.Text) Then .Cells(lZeile, 6).Value = CDbl(TextBox6.Text)
.Cells(lZeile, 7).Value = Format(TextBox7.Text, "0 °C")
If IsNumeric(TextBox8.Text) Then .Cells(lZeile, 8).Value = CDbl(TextBox8.Text)
TextBox9.Value = .Cells(lZeile, 8).Value - .Cells(lZeile - 1, 8).Value
If IsNumeric(TextBox9.Text) Then .Cells(lZeile, 9).Value = CDbl(TextBox9.Text)
.Cells(lZeile, 10).Value = Format(TextBox10.Text, "0 °C")
If IsNumeric(TextBox11.Text) Then .Cells(lZeile, 11).Value = CDbl(TextBox11.Text)
TextBox12.Value = .Cells(lZeile, 11).Value - .Cells(lZeile - 1, 11).Value
If IsNumeric(TextBox12.Text) Then .Cells(lZeile, 12).Value = CDbl(TextBox12.Text)
.Cells(lZeile, 13).Value = Format(TextBox13.Text, "0 °C")
If IsNumeric(TextBox14.Text) Then .Cells(lZeile, 14).Value = CDbl(TextBox14.Text)
TextBox15.Value = .Cells(lZeile, 14).Value - .Cells(lZeile - 1, 14).Value
If IsNumeric(TextBox15.Text) Then .Cells(lZeile, 15).Value = CDbl(TextBox15.Text)
.Cells(lZeile, 16).Value = Format(TextBox16.Text, "0 °C")
If IsNumeric(TextBox17.Text) Then .Cells(lZeile, 17).Value = CDbl(TextBox17.Text)
TextBox18.Value = .Cells(lZeile, 17).Value - .Cells(lZeile - 1, 17).Value
If IsNumeric(TextBox18.Text) Then .Cells(lZeile, 18).Value = CDbl(TextBox18.Text)
.Cells(lZeile, 19).Value = Format(TextBox19.Text, "0 °C")
If IsNumeric(TextBox20.Text) Then .Cells(lZeile, 20).Value = CDbl(TextBox20.Text)
If IsNumeric(TextBox21.Text) Then .Cells(lZeile, 21).Value = CDbl(TextBox21.Text)
TextBox22.Value = .Cells(lZeile, 21).Value - .Cells(lZeile - 1, 21).Value
If IsNumeric(TextBox22.Text) Then .Cells(lZeile, 22).Value = TextBox22.Text
.Cells(lZeile, 23).Value = Format(TextBox23.Text, "0 °C")
If IsNumeric(TextBox24.Text) Then .Cells(lZeile, 24).Value = CDbl(TextBox24.Text)
If ListBox1.Text  Trim(CStr(TextBox1.Text)) Then
Call UserForm_Initialize
If ListBox1.ListCount > 0 Then ListBox1.ListIndex = 0
End If
Exit Do
End If
lZeile = lZeile + 1 'Nächste Zeile bearbeiten
Loop
End With
End If
ErrExit:
With Err
If .Number  0 Then
MsgBox "Fehler in Prozedur:" & vbTab & "'CommandButton3_Click'" & vbLf & String(60, "_") &  _
_
vbLf & vbLf & IIf(Erl, "Fehler in Zeile:" & vbTab & Erl & vbLf & vbLf, "") & _
"Fehlernummer:" & vbTab & .Number & vbLf & vbLf & "Beschreibung:" & vbTab & _
.Description & vbLf, vbExclamation + vbMsgBoxSetForeground, _
"VBA - Fehler in Prozedur - CommandButton3_Click"
.Clear
End If
End With
On Error GoTo 0
With Application
.ScreenUpdating = True
.EnableEvents = True
.Calculation = xlAutomatic
.DisplayAlerts = True
.StatusBar = False
End With
End Sub

'Klick auf die ListBox Ereignisroutine
Private Sub ListBox1_Click()
Dim lZeile As Long
'Wenn der Benutzer einen Namen anklickt, suchen wir
'diesen in der Tabelle2 heraus und tragen die Daten
'in die TextBoxen ein.
lZeile = Cells(Rows.Count, 1).End(xlUp).Row
'Wir löschen standardmäßig alle bisherigen TextBoxen-Inhalte
TextBox1 = ""
TextBox2 = ""
TextBox3 = ""
TextBox4 = ""
TextBox5 = ""
TextBox6 = ""
TextBox7 = ""
TextBox8 = ""
TextBox9 = ""
TextBox10 = ""
TextBox11 = ""
TextBox12 = ""
TextBox13 = ""
TextBox14 = ""
TextBox15 = ""
TextBox16 = ""
TextBox17 = ""
TextBox18 = ""
TextBox19 = ""
TextBox20 = ""
TextBox21 = ""
TextBox22 = ""
TextBox23 = ""
TextBox24 = ""
'Nur wenn ein Eintrag selektiert/markiert ist
If ListBox1.ListIndex >= 0 Then
lZeile = 4 'Start in Zeile 4, Zeile 1 sind ja die Überschriftrn
'Schleife solange etwas in der ersten Spalte in Tabelle 1 drin steht
Do While Trim(CStr(Tabelle2.Cells(lZeile, 1).Value))  ""
'Wenn wir den Namen aus der ListBox1 in der Tabelle2 Spalte 1
'gefunden haben, übertragen wir die anderen Spalteninhalte
'in die TextBoxen!
If ListBox1.Text = Trim(CStr(Tabelle2.Cells(lZeile, 1).Value)) Then
'TextBoxen füllen
TextBox1 = Trim(CStr(Tabelle2.Cells(lZeile, 1).Value))
TextBox2 = Tabelle2.Cells(lZeile, 2).Value
TextBox3 = Tabelle2.Cells(lZeile, 3).Value
TextBox4 = Tabelle2.Cells(lZeile, 4).Value
TextBox5 = Tabelle2.Cells(lZeile, 5).Value
TextBox6 = Tabelle2.Cells(lZeile, 6).Value
TextBox7 = Tabelle2.Cells(lZeile, 7).Value
TextBox8 = Tabelle2.Cells(lZeile, 8).Value
TextBox9 = Tabelle2.Cells(lZeile, 9).Value
TextBox10 = Tabelle2.Cells(lZeile, 10).Value
TextBox11 = Tabelle2.Cells(lZeile, 11).Value
TextBox12 = Tabelle2.Cells(lZeile, 12).Value
TextBox13 = Tabelle2.Cells(lZeile, 13).Value
TextBox14 = Tabelle2.Cells(lZeile, 14).Value
TextBox15 = Tabelle2.Cells(lZeile, 15).Value
TextBox16 = Tabelle2.Cells(lZeile, 16).Value
TextBox17 = Tabelle2.Cells(lZeile, 17).Value
TextBox18 = Tabelle2.Cells(lZeile, 18).Value
TextBox19 = Tabelle2.Cells(lZeile, 19).Value
TextBox20 = Tabelle2.Cells(lZeile, 20).Value
TextBox21 = Tabelle2.Cells(lZeile, 21).Value
TextBox22 = Tabelle2.Cells(lZeile, 22).Value
TextBox23 = Tabelle2.Cells(lZeile, 23).Value
TextBox24 = Tabelle2.Cells(lZeile, 24).Value
Exit Do 'Vorzeitiges Ende, da der Datensatz schon gefunden ist
End If
lZeile = lZeile + 1 'Nächste Zeile bearbeiten
Loop
End If
End Sub

1
Beitrag zum Forumthread
Beitrag zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: TextBox als Datumsformat wird nicht berechnet
19.12.2016 13:36:57
Daniel
Hi
das dürfe daran liegen, dass du den Textboxwert als Text in die Zelle zurückschreibst (Format) und Excel dann diesen Text nicht als Datum interpretieren kann, weil er über VBA in die Zelle geschrieben wird und daher der amerikanischen Schreibweise entsprechen muss, um als Datum erkannt zu werden.
probier das Rückschreiben mal einfach mit
...Value = CDate(Textbox1.Text)

bzw wenn das auch nicht geht, mit
...Value = CLng(CDate(Textbox1.Text))

der Ganzzahlwert des Datum sollte auf jeden Fall korrekt übernommen werden.
Gruß Daniel
Anzeige

344 Forumthreads zu ähnlichen Themen

Anzeige
Anzeige
Anzeige

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige