Live-Forum - Die aktuellen Beiträge
Anzeige
Archiv - Navigation
1524to1528
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

Berechnung automatisch

Berechnung automatisch
23.11.2016 16:05:30
chris58
Hallo !
Ich benötige Eure Hilfe bezüglich des u.a. Script´s.
Ich übertrage Daten in die gleiche Tabelle mit der Bezeichnung "Berechnung", damit ich eine Übersicht habe. Nun habe ich in Spalte G und M folgende Formel stehen, die ich jeweils immer nachziehen muß, da diese aus den eingefügten Daten (A=Datum und B=Zahlen) die Differenz zwischen den einzelnen Datums errechnet.
Meine Frage ist nun, kann ich die Formel gleich in diesen Code einbauen, damit die Berechnung automatisch abläuft. Bisher ziehe ich mit der Maus immer die Formel nach.
Also Formel immer vom Vordatum zum aktuellen Datum, abgeglichen mit der Zahlenreihe.
Spalte G =(B41-B40)/(A41-A40)nächste Zeile =(B42-B41)/(A42-A41) usw.
Spalte M =(H41-H40)/(A41-A40)nächste Zeile =(H42-H41)/(A42-A41) usw.
Danke
chris
Sub Protokoll()
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("B8")
TB.Cells(sMaxZeile, 2) = ActiveWorkbook.ActiveSheet.Range("B7")
TB.Cells(sMaxZeile, 3) = ActiveWorkbook.ActiveSheet.Range("B12")
TB.Cells(sMaxZeile, 4) = ActiveWorkbook.ActiveSheet.Range("B13")
TB.Cells(sMaxZeile, 5) = ActiveWorkbook.ActiveSheet.Range("B14")
TB.Cells(sMaxZeile, 6) = ActiveWorkbook.ActiveSheet.Range("B15")
TB.Cells(sMaxZeile, 8) = ActiveWorkbook.ActiveSheet.Range("E7")
TB.Cells(sMaxZeile, 9) = ActiveWorkbook.ActiveSheet.Range("E12")
TB.Cells(sMaxZeile, 10) = ActiveWorkbook.ActiveSheet.Range("E13")
TB.Cells(sMaxZeile, 11) = ActiveWorkbook.ActiveSheet.Range("E14")
TB.Cells(sMaxZeile, 12) = ActiveWorkbook.ActiveSheet.Range("E15")
Application.ScreenUpdating = True
End Sub

6
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Berechnung automatisch
23.11.2016 19:48:40
Ur-Opa
Hallo Chris
nachfolgend Dein Makro mit automatisch eingefügten Formeln.
Bitte noch mal checken, weil ich es nicht getestet habe.
Der Trick liegt drin, dass die Z1S1-Bezugsart verwendet wird. Dabei wird eine Zelle nicht über Buchstabe/Zeilennummer sondern über Zeilennummer/Spaltennummer adressiert.
RC2 bedeutet gleiche Zeile / Spalte 2 (absolut)
R[-1]C2) bedeutet eine Zeile höher (relativ) / Spalte 2 (absolut)
Die Bezugsart am Besten mal über "Datei / Optionen / Formeln" ein- und ausschalten,
und schauen, wie es im Worksheet aussieht.
Für Makros ist die Z1S1-Bezugsart besser geeignet als die A1-Bezugsart, weil
man dann nicht irgendwelche Buchstaben ermitteln muss, um Zellen zu adressieren.
Sub Protokoll()
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("B8")
TB.Cells(sMaxZeile, 2) = ActiveWorkbook.ActiveSheet.Range("B7")
TB.Cells(sMaxZeile, 3) = ActiveWorkbook.ActiveSheet.Range("B12")
TB.Cells(sMaxZeile, 4) = ActiveWorkbook.ActiveSheet.Range("B13")
TB.Cells(sMaxZeile, 5) = ActiveWorkbook.ActiveSheet.Range("B14")
TB.Cells(sMaxZeile, 6) = ActiveWorkbook.ActiveSheet.Range("B15")
'   Formel in Spalte G
TB.Cells(sMaxZeile, 7).FormulaR1C1 = "=(RC2-R[-1]C2)/((RC1-R[-1]C1)"
TB.Cells(sMaxZeile, 8) = ActiveWorkbook.ActiveSheet.Range("E7")
TB.Cells(sMaxZeile, 9) = ActiveWorkbook.ActiveSheet.Range("E12")
TB.Cells(sMaxZeile, 10) = ActiveWorkbook.ActiveSheet.Range("E13")
TB.Cells(sMaxZeile, 11) = ActiveWorkbook.ActiveSheet.Range("E14")
TB.Cells(sMaxZeile, 12) = ActiveWorkbook.ActiveSheet.Range("E15")
TB.Cells(sMaxZeile, 13).FormulaR1C1 = "=(RC8-R[-1]C8)/((RC1-R[-1]C1)"
'   Formel in Spalte  M
Application.ScreenUpdating = True
End Sub

Viel Erfolg
Ur-Opa
Anzeige
AW: Berechnung automatisch
23.11.2016 21:06:04
chris58
Hallo !
Das geht nicht. Die Werte werden wie vorher übertragen, jedoch die Berechnung wird nicht ausgeführt. Es kommt der Fehler VB X400. Kann man eventuell die Berechnung nur in ein eigenes Modul machen, das ich dann mit dem Button gleichzeitig starte?
Danke
chris
AW: Berechnung automatisch
23.11.2016 23:52:54
Ur-Opa
Hallo Chris,
Ein separates Modul ist nicht nötig.
Wie schon gesagt, war nicht getestet - in der Formel war eine Klammer zu viel geöffnet
TB.Cells(sMaxZeile, 7).FormulaR1C1 = "=(RC2-R[-1]C2)/((RC1-R[-1]C1)" - muss heissen
TB.Cells(sMaxZeile, 7).FormulaR1C1 = "=(RC2-R[-1]C2)/(RC1-R[-1]C1)"
betrifft auch die zweite Formel:
TB.Cells(sMaxZeile, 13).FormulaR1C1 = "=(RC8-R[-1]C8)/(RC1-R[-1]C1)"
Dann sollte es eigentlich klappen.
Ur-Opa
Anzeige
AW: Berechnung automatisch
23.11.2016 23:55:59
Luschi
Hallo Chris,
die Formel muß so lauten:
TB.Cells(sMaxZeile, 7).FormulaR1C1 = "=(RC2-R[-1]C2)/(RC1-R[-1]C1)"
statt
TB.Cells(sMaxZeile, 7).FormulaR1C1 = "=(RC2-R[-1]C2)/((RC1-R[-1]C1)"
Gruß von Luschi
aus klein-Paris
AW: Berechnung automatisch
24.11.2016 07:47:57
chris58
Herzlichen Dank, das geht nun so, wie ich es mir vorgestellt habe.
chris

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige