AW: Formular bzw. Zahlen direkt in Zellen einlesen
28.08.2024 21:36:10
Yal
Hallo Chris,
wenn man Hilfe wegen einem Nadel fragt, sollte man vermeiden, eine ganzen Heuhaufen zu übergeben :-)
Ich habe doch entdeckt, dass es sich um CommandButton4_Click geht.
Was sich wiedeholt, sollte man in einer separaten Sub ablegen: "IstNichtNum"
Manche komplexere Handlung ("Blatt_selektieren") kann man auch -zweck Übersicht- getrennt behandeln. Insbesondere, weil die Handlung von "On Error" immer nur inerhalb eines Subs wirkt.
Das einzige, was ich problematisch finden könnte, ist die Formel in Spalte L
R.Cells(12).FormulaR1C1 = "=TEXT(RC[-12],""TTTT"")" 'Formel in Spalte L
Da L die Spalte 12 ist, RC[-12] ergibt Spalte 0, die es nicht gibt.
daher
R.Cells(12).FormulaR1C1 = "=TEXT(RC[-11],""TTTT"")" 'Formel in Spalte L
Private Sub CommandButton4_Click()
Dim i, j
Dim R As Range
Const cNeuesBlatt As String = "Berechnung"
'Prüfung. Wenn einer "ist nicht numerisch", dann raus
If IstNichtNum(TextBox4) Or IstNichtNum(TextBox5) Or IstNichtNum(TextBox6) Or IstNichtNum(TextBox7) Then Exit Sub
'Übertragung
Range("C17").Value = CDbl(TextBox4.Text)
Range("C18").Value = CDbl(TextBox5.Text)
Range("C20") = ComboBox1.Value
Range("C21").Value = CDbl(TextBox6.Text)
Range("C19").Value = CDbl(TextBox7.Text)
'Es passiert alle auf ActiveSheet
StartZeile = Range("A3").End(xlUp).Row + 5
Cells(StartZeile, "C") = CDbl(Format(TextBox1, "#,##0.00"))
Cells(StartZeile + 1, "C") = TextBox3
Application.ScreenUpdating = False
'Wert zum neuen Blatt übertragen
Set R = Blatt_selektieren(cNeuesBlatt).Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).EntireRow 'nächste leere Zeile ermitteln. R ist eine Zeile.
For Each i In Split("C7 C11 C6 C12 C13 C14 C21 C17 C18 C19 C20")
j = j + 1
R.Cells(j) = Range(i).Value 'Cells(1) von einer Zeile in der Spalte A dieser Zeile, 2 B, 3 C, usw.
Next
'Fromel einreichten
R.Cells(7).FormulaR1C1 = "=SUM(RC[1]+RC[4]-RC[2])" 'Formel in Spalte G: Gesamtverbrauch per Tag aus EVN & Einspeisung aus PV Anlage
R.Cells(8).FormulaR1C1 = "=(RC3-R[-1]C3)" 'Formel in Spalte H (relative Adressierung)
' =SUM(RC[1]+RC[4])
R.Cells(9).Interior.ColorIndex = 35 'Spalte I
' R.Cells(9).FormulaR1C1 = "=(RC[-1])/24"
R.Cells(12).FormulaR1C1 = "=TEXT(RC[-11],""TTTT"")" 'Formel in Spalte L
'Färbung
R.Interior.Pattern = xlSolid
R.Cells(5).Interior.ColorIndex = 36
R.Cells(7).Interior.ColorIndex = 34
'Abschluss
Range("A2").Select
Application.ScreenUpdating = True
Unload Me '--- Userform schließen
End Sub
Private Function Blatt_selektieren(ByVal BlattName As String) As Worksheet
Dim WS As Worksheet
'alles basiert auf ActiveWorkbook
On Error Resume Next
Set WS = Worksheets(BlattName)
If WS Is Nothing Then
Set WS = Worksheets.Add(After:=Worksheets(Worksheets.Count))
WS.Name = BlattName
End If
Set Blatt_selektieren = Worksheets(BlattName)
End Function
Private Function IstNichtNum(TxtBx As Control) As Boolean
If Not IsNumeric(TxtBx.Text) Then
MsgBox "PV Einspeisung eigeben - oder 0!" '---> Meldung
TxtBx.SetFocus '---> Textbox aktivieren
IstNichtNum = True
End If
End Function
(ungetestet)
VG
Yal