Einfügen Formel & Berechnung

Hallo zusammen,
ich komme gerade mit einem VBA-Problem nicht weiter.
Ich habe eine Tabelle mit unterschiedlicher Zellenanzahl. Von der Spalte C muss die Summe gebildet werden. Die Werte in Spalte C sollen durch die Summe der Spalte C dividiert werden und zwar bis zur letzten beschriebenen Zelle. Das Ergebnis soll in Spalte D in den jeweiligen Zeilen gespeichert werden. Anschließend sollen die Werte der Spalte D kumuliert werden und in Spalte E geschrieben werden.
Die Summe der Spalte C habe ich gebildet, jedoch komme ich mit der Berechnung der Spalte D (Zellwerte D durch Summe Spalte C) in VBA nicht weiter.
Kann mir jemand sagen, wie ich das in VBA realisiere?
Ciao Björn
https://www.herber.de/bbs/user/52454.xls

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Sub test() Dim anzZeilen, i, summe anzZeilen = Cells(65536, Range("A1").Column).End(xlUp).Row summe = 0 For i = 2 To anzZeilen summe = summe + Range("C" & i).Value Next i Range("C" & anzZeilen + 1).Value = summe For i = 2 To anzZeilen Range("D" & i).Value = Range("C" & i).Value / summe * 100 Range("E" & 2).Value = Range("D" & 2).Value Next i Range("E" & 2).Value = Range("D" & 2).Value For i = 3 To anzZeilen Range("E" & i).Value = Range("E" & i - 1).Value + Range("D" & i).Value Next i End Sub

Sub test() Dim lngLetzte As Long Dim strSumme As String, dbSumme As Double lngLetzte = IIf(IsEmpty(Cells(Rows.Count, 3)), Cells(Rows.Count, 3).End(xlUp).Row, Rows.Count) strSumme = WorksheetFunction.Sum(Range("C2:C" & lngLetzte)) dbSumme = strSumme With Range("D2:D" & lngLetzte) .FormulaR1C1 = "=RC[-1]/" & dbSumme & "*100" .Formula = .Value End With With Range("E2") .FormulaR1C1 = "=RC[-1]" .Formula = .Value End With With Range("E3:E" & lngLetzte) .FormulaR1C1 = "=R[-1]C+RC[-1]" .Formula = .Value End With End Sub

Sub version() Range("D2:D" & Range("C" & Rows.Count).End(xlUp).Row).Formula = "=C2/SUM(C:C)%" Range("E2").Formula = "=D2" Range("E3:E" & Range("C" & Rows.Count).End(xlUp).Row).Formula = "=E2+D3" Range("D2:E" & Range("C" & Rows.Count).End(xlUp).Row).Copy Range("D2").PasteSpecial Paste:=xlPasteValues Application.CutCopyMode = False End Sub

Hallo Björn,
hier 2 Vorschläge zur VBA-Lösung
Nummer 1 trägt die Auswertungsergebnis in die Tabelle ein.
Nummer 2 fügt die Berechnungsformeln ein.
Bei den Formeln hab ich fürd kumulierte Ergebnis eine Summenformel verwendet.
Damit die Formeln gut funktionieren (kopierfähig sind) müssen einige Bezüge in den Formeln absolut gesetzt werden.


Formel in D2: =C2/$C$21 * 100
Formel in E2: =SUMME($D$2:D2)
Formel in C21: =SUMME($C$2:C20)

Gruß
Franz


Sub Auswertung()
'Trägt die Auswertungsergebnisse im Blatt ein
Dim lngZeile As Long, dblSumme As Double, objWks As Worksheet
Const lngSpWert As Long = 3 'Spalte C
Const lngSpErg As Long = 4 'Spalte D
Const lngSpKum As Long = 5 'Spalte E
Const lngZeile1 As Long = 2 '1. Zeile mit Wert
Set objWks = ActiveSheet
With objWks
If .Cells(.Rows.Count, lngSpWert).End(xlUp).Row >= lngZeile1 Then
'Summe berechnen
dblSumme = Application.WorksheetFunction.Sum(.Range(.Cells(lngZeile1, lngSpWert), _
.Cells(.Rows.Count, lngSpWert).End(xlUp)))
'Ergebnis- und kumulierte Spalte berechnen und ausfüllen
For lngZeile = lngZeile1 To .Cells(.Rows.Count, lngSpWert).End(xlUp).Row
'Ergebnis
.Cells(lngZeile, lngSpErg).Value = .Cells(lngZeile, lngSpWert).Value / dblSumme * 100
'kumuliert
If lngZeile = lngZeile1 Then
.Cells(lngZeile, lngSpKum).Value = .Cells(lngZeile, lngSpErg).Value
Else
.Cells(lngZeile, lngSpKum).Value = .Cells(lngZeile - 1, lngSpKum).Value + _
.Cells(lngZeile, lngSpErg).Value
End If
Next
'Summe eintragen
.Cells(.Rows.Count, lngSpWert).End(xlUp).Offset(1, 0).Value = dblSumme
End If
End With
End Sub
Sub AuswertungFormel()
'Trägt die Auswertungsformeln im Blatt ein
Dim lngZeile As Long, objWks As Worksheet
Dim lngZeileL As Long
Const lngSpWert As Long = 3 'Spalte C
Const lngSpErg As Long = 4 'Spalte D
Const lngSpKum As Long = 5 'Spalte E
Const lngZeile1 As Long = 2 '1. Zeile mit Wert
Set objWks = ActiveSheet
With objWks
'Letzte Zeile berechnen
lngZeileL = .Cells(.Rows.Count, lngSpWert).End(xlUp).Row
If lngZeileL

Beliebteste Forumthreads (12 Monate)

5
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

300 Forumthreads zu ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

Einfügen Formel & Berechnung

5 Beiträge zum Forumthread Beiträge zu diesem Forumthread

300 Forumthreads zu ähnlichen Themen

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

5
Beiträge zum Forumthread

Beiträge zu diesem Forumthread