AW: Zahl in UF einfügen, korregieren u. rück
27.05.2023 09:24:00
chris58
Hallo Piet !
Ich habe die letzte Nacht "gespielt" und habe es etwas anders gemacht. Es tut mir leid, das du dir soviel Arbeit gemacht hast.
Ich habe beim "Daten holen" was gefunden, das holt mir nur die Tausenderstelle in das Formular. Das hat den Vorteil, das ich dann nichts löschen muß, sondern die letzten 5 Zahlen eintragen kann. Auf dem Formular sind 4 Button angebracht. Meine Frage ist nun: Kann man die Codes der Button 1 + 4 in einen Button vereinen, damit ich nur einen Button benötige ?
Danke chris58
Option Explicit
Private Sub CommandButton1_Click()
Dim StartZeile&
Dim Ws As Worksheet
Set Ws = ActiveSheet
StartZeile = Ws.Cells(3, 1).End(xlUp).Row + 5
Ws.Cells(StartZeile, 3) = CDbl(Format(TextBox1, "#,##0.00"))
Ws.Cells(StartZeile + 1, 3) = TextBox3
End Sub
Private Sub CommandButton2_Click()
Unload Me
End Sub
Private Sub CommandButton3_Click()
Dim StartZeile&
Dim Ws As Worksheet
Set Ws = ActiveSheet
StartZeile = Ws.Cells(3, 1).End(xlUp).Row + 5
TextBox1 = CDbl(Format(Ws.Cells(StartZeile, 3), "0 ,"""))
UserForm1.TextBox1.SetFocus
Ws.Cells(StartZeile + 1, 3) = TextBox3
End Sub
Private Sub CommandButton4_Click()
Dim i As Long
Const NewConstSheet As String = "Berechnung"
Dim bfound As Boolean
Dim sMerk As String
Dim sMaxZeile As Long
Dim TB As Worksheet
Application.ScreenUpdating = False
'Prüfen ob Tabelle NewConstSheet schon angelegt ist
For i = 1 To ActiveWorkbook.Sheets.Count
If ActiveWorkbook.Sheets(i).Name = NewConstSheet Then
bfound = True
Exit For
End If
Next i
'wenn nicht dann anlegen
If bfound = False Then
sMerk = ActiveWorkbook.ActiveSheet.Name
ActiveWorkbook.Sheets.Add after:=ActiveWorkbook.Sheets(ActiveWorkbook.Sheets.Count)
ActiveWorkbook.ActiveSheet.Name = NewConstSheet
ActiveWorkbook.Sheets(sMerk).Activate
End If
Set TB = ActiveWorkbook.Sheets(NewConstSheet)
'nächste leere Zeile ermitteln
sMaxZeile = TB.Cells(TB.Rows.Count, 1).End(xlUp).Row + 1
'Daten in neue Tabelle übertragen
TB.Cells(sMaxZeile, 1) = ActiveWorkbook.ActiveSheet.Range("C7")
TB.Cells(sMaxZeile, 2) = ActiveWorkbook.ActiveSheet.Range("B7")
TB.Cells(sMaxZeile, 3) = ActiveWorkbook.ActiveSheet.Range("C6")
TB.Cells(sMaxZeile, 4) = ActiveWorkbook.ActiveSheet.Range("C12")
TB.Cells(sMaxZeile, 5) = ActiveWorkbook.ActiveSheet.Range("C13")
TB.Cells(sMaxZeile, 6) = ActiveWorkbook.ActiveSheet.Range("C14")
TB.Cells(sMaxZeile, 7) = ActiveWorkbook.ActiveSheet.Range("C15")
TB.Cells(sMaxZeile, 10) = ActiveWorkbook.ActiveSheet.Range("D7")
' Formel in Spalte G
TB.Cells(sMaxZeile, 8).FormulaR1C1 = "=(RC3-R[-1]C3)/(RC1-R[-1]C1)"
' Formel in Spalte I
TB.Cells(sMaxZeile, 9).FormulaR1C1 = "=(RC[-1])/24"
' Formel in Spalte J
TB.Cells(sMaxZeile, 10).FormulaR1C1 = "=TEXT(RC[-9]-1,""TTTT"")"
Range("A2").Select
Application.ScreenUpdating = True
End Sub