Spalten und Zeilen berechnen mit bedingungen

Sub Stromverbrauch1() Dim i As Integer Dim letzteZeile As Integer Set w1 = Tabelle1 Set w2 = Tabelle4 letzteZeile = Cells(Rows.Count, 9).End(xlUp).Row w2.Activate For i = 6 To letzteZeile 'Januar If w1.Cells(i, 7).Value "" Then w2.Cells(i, 6).Value = (w1.Cells(i, 10).Value - w1.Cells(i, 9).Value) * w1.Cells(i, 7). _ Value End If Next i End Sub

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Hallo,
habe das soweit für jeden Monat mit Multiplikator hinbekommen.
Wie bekomme ich das hin das die Zeilen mit den Bedingungen der Kurzz. berechnent werden
Kurzz. Berechnung
R______R-R1-R2
B______B-B1
C______C-C1
D______D-D1
E______E-E1-E2
H______H-H1
M1_____M1+M2
M5_____M5a +M7a+M8+M7+M5
M1_____M1-M4
P1____(P1-P2)+(P3-P4)
z.B.
Wenn in Splate H das Kurzzeichen R,R1,R2 steht sollen die Zeilen von R-R1-R2 in der Tabelle Stromverbrauch für die einzelnen Monate berechnent werden.
Gruß Andi
Bedanke mich schon mal in vorraus!
Hier nochmal eine aktuelle Datei:
https://www.herber.de/bbs/user/102183.xlsm
Der aktuelle Code:

Sub Stromverbrauch()
Dim i As Integer
Set w1 = Tabelle1
Set w2 = Tabelle4
letzteZeile = w1.Cells(Rows.Count, 9).End(xlUp).Row
w2.Activate
For i = 6 To letzteZeile
'Januar
If w1.Cells(i, 7).Value  "" Then
w2.Cells(i, 6).Value = (w1.Cells(i, 10).Value - w1.Cells(i, 9).Value) * w1.Cells(i, 7). _
Value
Else
w2.Cells(i, 6).Value = (w1.Cells(i, 10).Value - w1.Cells(i, 9).Value)
End If
If w1.Cells(i, 9).Value = "" Then
w2.Cells(i, 6).Value = ""
End If
'Februar
If w1.Cells(i, 7).Value  "" Then
w2.Cells(i, 7).Value = (w1.Cells(i, 11).Value - w1.Cells(i, 10).Value) * w1.Cells(i, 7). _
Value
Else
w2.Cells(i, 7).Value = (w1.Cells(i, 11).Value - w1.Cells(i, 10).Value)
End If
If w1.Cells(i, 10).Value = "" Then
w2.Cells(i, 7).Value = ""
End If
'März
If w1.Cells(i, 7).Value  "" Then
w2.Cells(i, 8).Value = (w1.Cells(i, 12).Value - w1.Cells(i, 11).Value) * w1.Cells(i, 7). _
Value
Else
w2.Cells(i, 8).Value = (w1.Cells(i, 12).Value - w1.Cells(i, 11).Value)
End If
If w1.Cells(i, 11).Value = "" Then
w2.Cells(i, 8).Value = ""
End If
'April
If w1.Cells(i, 7).Value  "" Then
w2.Cells(i, 9).Value = (w1.Cells(i, 13).Value - w1.Cells(i, 12).Value) * w1.Cells(i, 7). _
Value
Else
w2.Cells(i, 9).Value = (w1.Cells(i, 13).Value - w1.Cells(i, 12).Value)
End If
If w1.Cells(i, 12).Value = "" Then
w2.Cells(i, 9).Value = ""
End If
'Mai
If w1.Cells(i, 7).Value  "" Then
w2.Cells(i, 10).Value = (w1.Cells(i, 14).Value - w1.Cells(i, 13).Value) * w1.Cells(i, 7) _
.Value
Else
w2.Cells(i, 10).Value = (w1.Cells(i, 14).Value - w1.Cells(i, 13).Value)
End If
If w1.Cells(i, 13).Value = "" Then
w2.Cells(i, 10).Value = ""
End If
'Juni
If w1.Cells(i, 7).Value  "" Then
w2.Cells(i, 11).Value = (w1.Cells(i, 15).Value - w1.Cells(i, 14).Value) * w1.Cells(i, 7) _
.Value
Else
w2.Cells(i, 11).Value = (w1.Cells(i, 15).Value - w1.Cells(i, 14).Value)
End If
If w1.Cells(i, 14).Value = "" Then
w2.Cells(i, 11).Value = ""
End If
'Juli
If w1.Cells(i, 7).Value  "" Then
w2.Cells(i, 12).Value = (w1.Cells(i, 16).Value - w1.Cells(i, 15).Value) * w1.Cells(i, 7) _
.Value
Else
w2.Cells(i, 12).Value = (w1.Cells(i, 16).Value - w1.Cells(i, 15).Value)
End If
If w1.Cells(i, 15).Value = "" Then
w2.Cells(i, 12).Value = ""
End If
'August
If w1.Cells(i, 7).Value  "" Then
w2.Cells(i, 13).Value = (w1.Cells(i, 17).Value - w1.Cells(i, 16).Value) * (w1.Cells(i,  _
7).Value)
Else
w2.Cells(i, 13).Value = (w1.Cells(i, 17).Value - w1.Cells(i, 16).Value)
End If
If w1.Cells(i, 16).Value = "" Then
w2.Cells(i, 13).Value = ""
End If
'September
If w1.Cells(i, 7).Value  "" Then
w2.Cells(i, 14).Value = (w1.Cells(i, 18).Value - w1.Cells(i, 17).Value) * (w1.Cells(i,  _
7).Value)
Else
w2.Cells(i, 14).Value = (w1.Cells(i, 18).Value - w1.Cells(i, 17).Value)
End If
If w1.Cells(i, 17).Value = "" Then
w2.Cells(i, 14).Value = ""
End If
'Oktober
If w1.Cells(i, 7).Value  "" Then
w2.Cells(i, 15).Value = (w1.Cells(i, 19).Value - w1.Cells(i, 18).Value) * (w1.Cells(i,  _
7).Value)
Else
w2.Cells(i, 15).Value = (w1.Cells(i, 19).Value - w1.Cells(i, 18).Value)
End If
If w1.Cells(i, 18).Value = "" Then
w2.Cells(i, 15).Value = ""
End If
'November
If w1.Cells(i, 7).Value  "" Then
w2.Cells(i, 16).Value = (w1.Cells(i, 20).Value - w1.Cells(i, 19).Value) * (w1.Cells(i,  _
7).Value)
Else
w2.Cells(i, 16).Value = (w1.Cells(i, 20).Value - w1.Cells(i, 19).Value)
End If
If w1.Cells(i, 19).Value = "" Then
w2.Cells(i, 16).Value = ""
End If
'Dezember
If w1.Cells(i, 7).Value  "" Then
w2.Cells(i, 17).Value = (w1.Cells(i, 21).Value - w1.Cells(i, 20).Value) * (w1.Cells(i,  _
7).Value)
Else
w2.Cells(i, 17).Value = (w1.Cells(i, 21).Value - w1.Cells(i, 20).Value)
End If
If w1.Cells(i, 21).Value = "" Then
w2.Cells(i, 17).Value = ""
End If
Next i
End Sub

Sub Stromverbrauch() Dim i As Integer Set w1 = Tabelle1 Set w2 = Tabelle4 letzteZeile = w1.Cells(Rows.Count, 9).End(xlUp).Row w2.Activate For i = 6 To letzteZeile 'Januar If w1.Cells(i, 7).Value "" Then w2.Cells(i, 6).Value = (w1.Cells(i, 10).Value - w1.Cells(i, 9).Value) * w1.Cells(i, 7). _ Value Else w2.Cells(i, 6).Value = (w1.Cells(i, 10).Value - w1.Cells(i, 9).Value) End If If w1.Cells(i, 9).Value = "" Then w2.Cells(i, 6).Value = "" End If 'Februar If w1.Cells(i, 7).Value "" Then w2.Cells(i, 7).Value = (w1.Cells(i, 11).Value - w1.Cells(i, 10).Value) * w1.Cells(i, 7). _ Value Else w2.Cells(i, 7).Value = (w1.Cells(i, 11).Value - w1.Cells(i, 10).Value) End If If w1.Cells(i, 10).Value = "" Then w2.Cells(i, 7).Value = "" End If 'März If w1.Cells(i, 7).Value "" Then w2.Cells(i, 8).Value = (w1.Cells(i, 12).Value - w1.Cells(i, 11).Value) * w1.Cells(i, 7). _ Value Else w2.Cells(i, 8).Value = (w1.Cells(i, 12).Value - w1.Cells(i, 11).Value) End If If w1.Cells(i, 11).Value = "" Then w2.Cells(i, 8).Value = "" End If 'April If w1.Cells(i, 7).Value "" Then w2.Cells(i, 9).Value = (w1.Cells(i, 13).Value - w1.Cells(i, 12).Value) * w1.Cells(i, 7). _ Value Else w2.Cells(i, 9).Value = (w1.Cells(i, 13).Value - w1.Cells(i, 12).Value) End If If w1.Cells(i, 12).Value = "" Then w2.Cells(i, 9).Value = "" End If 'Mai If w1.Cells(i, 7).Value "" Then w2.Cells(i, 10).Value = (w1.Cells(i, 14).Value - w1.Cells(i, 13).Value) * w1.Cells(i, 7) _ .Value Else w2.Cells(i, 10).Value = (w1.Cells(i, 14).Value - w1.Cells(i, 13).Value) End If If w1.Cells(i, 13).Value = "" Then w2.Cells(i, 10).Value = "" End If 'Juni If w1.Cells(i, 7).Value "" Then w2.Cells(i, 11).Value = (w1.Cells(i, 15).Value - w1.Cells(i, 14).Value) * w1.Cells(i, 7) _ .Value Else w2.Cells(i, 11).Value = (w1.Cells(i, 15).Value - w1.Cells(i, 14).Value) End If If w1.Cells(i, 14).Value = "" Then w2.Cells(i, 11).Value = "" End If 'Juli If w1.Cells(i, 7).Value "" Then w2.Cells(i, 12).Value = (w1.Cells(i, 16).Value - w1.Cells(i, 15).Value) * w1.Cells(i, 7) _ .Value Else w2.Cells(i, 12).Value = (w1.Cells(i, 16).Value - w1.Cells(i, 15).Value) End If If w1.Cells(i, 15).Value = "" Then w2.Cells(i, 12).Value = "" End If 'August If w1.Cells(i, 7).Value "" Then w2.Cells(i, 13).Value = (w1.Cells(i, 17).Value - w1.Cells(i, 16).Value) * (w1.Cells(i, _ 7).Value) Else w2.Cells(i, 13).Value = (w1.Cells(i, 17).Value - w1.Cells(i, 16).Value) End If If w1.Cells(i, 16).Value = "" Then w2.Cells(i, 13).Value = "" End If 'September If w1.Cells(i, 7).Value "" Then w2.Cells(i, 14).Value = (w1.Cells(i, 18).Value - w1.Cells(i, 17).Value) * (w1.Cells(i, _ 7).Value) Else w2.Cells(i, 14).Value = (w1.Cells(i, 18).Value - w1.Cells(i, 17).Value) End If If w1.Cells(i, 17).Value = "" Then w2.Cells(i, 14).Value = "" End If 'Oktober If w1.Cells(i, 7).Value "" Then w2.Cells(i, 15).Value = (w1.Cells(i, 19).Value - w1.Cells(i, 18).Value) * (w1.Cells(i, _ 7).Value) Else w2.Cells(i, 15).Value = (w1.Cells(i, 19).Value - w1.Cells(i, 18).Value) End If If w1.Cells(i, 18).Value = "" Then w2.Cells(i, 15).Value = "" End If 'November If w1.Cells(i, 7).Value "" Then w2.Cells(i, 16).Value = (w1.Cells(i, 20).Value - w1.Cells(i, 19).Value) * (w1.Cells(i, _ 7).Value) Else w2.Cells(i, 16).Value = (w1.Cells(i, 20).Value - w1.Cells(i, 19).Value) End If If w1.Cells(i, 19).Value = "" Then w2.Cells(i, 16).Value = "" End If 'Dezember If w1.Cells(i, 7).Value "" Then w2.Cells(i, 17).Value = (w1.Cells(i, 21).Value - w1.Cells(i, 20).Value) * (w1.Cells(i, _ 7).Value) Else w2.Cells(i, 17).Value = (w1.Cells(i, 21).Value - w1.Cells(i, 20).Value) End If If w1.Cells(i, 21).Value = "" Then w2.Cells(i, 17).Value = "" End If Next i End Sub

Option Explicit Sub Stromverbrauch_schnell() Dim i As Long, m As Long ' m wie monat Dim letzteZeile As Long Dim faktor As Long Dim a As Variant, f As Variant Const abZeile = 6 letzteZeile = Tabelle1.Cells(Rows.Count, 9).End(xlUp).Row a = Tabelle1.Range("I" & abZeile & ":U" & letzteZeile) f = Tabelle1.Range("G" & abZeile & ":G" & letzteZeile) For i = 1 To UBound(a, 1) If f(i, 1) "" Then faktor = f(i, 1) Else faktor = 1 For m = 1 To 12 If Not IsEmpty(a(i, m + 1)) Then a(i, m) = Round((a(i, m + 1) - a(i, m)) * faktor, 4) Else a(i, m) = "" End If Next m Next i Tabelle4.Range("F6").Resize(UBound(a, 1), 12) = a End Sub Sub Stromverbrauch() Dim i As Long, m As Long ' m wie monat Dim letzteZeile As Long Dim faktor As Long Dim w1 As Worksheet, w2 As Worksheet Set w1 = Tabelle1 Set w2 = Tabelle4 letzteZeile = w1.Cells(Rows.Count, 9).End(xlUp).Row For i = 6 To letzteZeile If w1.Cells(i, 7).Value "" Then faktor = w1.Cells(i, 7).Value Else faktor = 1 For m = 1 To 12 If w1.Cells(i, 9 + m).Value "" Then w2.Cells(i, m + 5).Value = Round( _ (w1.Cells(i, 9 + m).Value - w1.Cells(i, 8 + m).Value) * faktor, 4) Else Exit For End If Next m Next i End Sub

Hi Andi,
nach einigem Nachdenken habe ich, glaube ich, begriffen, was da passieren soll.
Ich habe mal die Spalte H nach "Kurzzeichen" kopiert, die Zeilennummern daneben eingetragen und das Ganze sortiert; das sieht dann etwa so aus:
Userbild

Diese Zuordnung von Kurzzeichen zu Zeilen kann man natürlich jedesmal neu erzeugen lassen, und ich denke, sie ist der erste (gedankliche) Schritt in Richtung Lösung.
Aber: Deine Angaben sind nicht konsistent (ich hab's jetzt nicht im Wörterbuch nachgeschlagen, hehe):
a) bei den P- und einigen M-Angaben sind Leerzeichen zwischen P und Nr.
b) P2 ist bei der Berechnung aufgeführt, in der Tabelle jedoch nicht vorhanden - entweder Du kümmerst Dich (IMMER) händisch darum, daß ALLE für Berechnungen notwendigen Kurzzeichen da sind, oder man muß eine entsprechende Fehlerbehandlung programmieren - ich weiß nicht, ob ich dazu Lust habe.
c) Rechenvorschriften für M1 sind doppelt vorgegeben. (sowohl im Forumstext als auch in der Datei)
d) zu X gibt es keine Berechnung.
Grundsätzlich möchte ich die Überlegung anstoßen, ob es nicht sinnvoller wäre, die paar Zeilen mit den Ergebnissen der Berechnungen (sind ja nur rund 10) *zusätzlich* in das Blatt einzufügen, d.h. zu jeder Vorschrift eine Zeile ohne eigene Zählerstände, etwa mit dem Kürzel "[Buchstabe]0".
Der Leser der Tabelle wird es Dir danken, wenn alle originalen Werte vorhanden sind PLUS die Berechnungen. Nicht zuletzt ist es so für *uns* in der Testphase einfacher nachzurechnen, ob alles paßt.
Schöne Grüße,
Michael

Beliebteste Forumthreads (12 Monate)

Spalten und Zeilen berechnen mit bedingungen

8
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

333 Forumthreads zu ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

Spalten und Zeilen berechnen mit bedingungen

8 Beiträge zum Forumthread Beiträge zu diesem Forumthread

333 Forumthreads zu ähnlichen Themen

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

8
Beiträge zum Forumthread

Beiträge zu diesem Forumthread