Office: Summewenns-Formel als VBA-Code

Hallo zusammen,

ich bin neu im Umgang mit VBA und stehe nun vor einem – für mich sehr großen - Problem.*frown.gif* *eek.gif*
Ich möchte die Formel „Summewenns“ in Verbindung mit der Wenn-Formel durch ein VBA-Makro ersetzen, sodass die Werte direkt in die jeweilige Zelle geschrieben werden.


Folgender Sachverhalt:
(Die Formel ist in Spalte G enthalten)

Anhand unterschiedlicher Kriterien (Spalte A-C) soll der jeweilige Betrag (Spalte E) mit einem Faktor (Tabellenblatt „Faktor“) multipliziert werden.
Dies soll jedoch nur geschehen, wenn die Klassifizierung auf „relevant“ (Spalte D) steht. Ist dies der Fall, wird der Betrag (E) durch 100+Aufschlag (F) geteilt und mit dem Faktor aus dem anderen Tabellenblatt multipliziert.

Wie sieht dazu der VBA-Code aus, wenn dieser in Spalte H die Werte eintragen soll (sodass die identischen zu Spalte G ermittelt werden)?

SCHON JETZT HERZLICHEN DANK FÜR EURE HILFE!!!


Gruß
PaulPower

:)

 

Hallo Paul,

warum willst du den per VBA berechnen?

' **********************************************************************
' Modul: Modul1 Typ: Allgemeines Modul
' **********************************************************************

Option Explicit

Sub berechne()
Dim rng As Range, rngF As Range, objFaktor As Worksheet
Dim varRet As Variant

Set objFaktor = Sheets("Faktor")

With Sheets("Übersicht")
Set rngF = .Range("D2:D" & Application.Max(2, .Cells(.Rows.Count, 4).End(xlUp).Row))
End With

With objFaktor
For Each rng In rngF
If LCase(rng) = "ja" Then
If IsNumeric(rng.Offset(0, 1)) Then
varRet = Application.SumIfs(.Columns(4), .Columns(3), rng.Offset(0, -1), .Columns(2), _
rng.Offset(0, -2), .Columns(1), rng.Offset(0, -3))

If IsNumeric(varRet) Then
rng.Offset(0, 4) = (rng.Offset(0, 1) / 100 + rng.Offset(0, 2)) * varRet
End If
End If
End If
Next
End With

End Sub

 

Hallo Josef E!

herzlichen Dank! Die Berechnung funktioniert und macht das gewünschte*biggrin.gif* !DANKE!

Zwei Bitten hätte ich noch:
1) Wenn Spalte D auf "nein" steht, lässt VBA nun die Berechnungszelle leer, kann man das so erstellen, dass dann "0" eingetragen wird?
2) Kannst Du den Code kommentieren, damit ich versuchen kann, das nachzuvollziehen? Durch Deine Hilfe bei dem Code kann ich nur dazulernen. Danke!

Ich benötige das in VBA, da die Zieldatei deutlich mehr Zeilen enthält und ggfs. noch eine Berechnung in der Spalte daneben auch ausgeführt werden soll (zukünftig). Da die Datei aber bereits sehr viele Formel enthält, ist sie dadurch sehr langsam. Das war nun der Versuch die Datei zu beschleunigen, indem die Summewenns-formel durch VBA abgelöst wird.

Gruß
PaulPower

 

Hallo Paul,

kein Problem.

Sub berechne()
Dim rng As Range, rngF As Range, objFaktor As Worksheet
Dim varRet As Variant

Set objFaktor = Sheets("Faktor") 'Referenz auf die Tabelle 'faktor'

With Sheets("Übersicht") 'bereich mit ja/nein in Übersicht bestimmen
Set rngF = .Range("D2:D" & Application.Max(2, .Cells(.Rows.Count, 4).End(xlUp).Row))
End With

With objFaktor
For Each rng In rngF 'Alle Zellen in D2:Dx durchlaufen
If LCase(rng) = "ja" Then 'Wenn 'Ja'
If IsNumeric(rng.Offset(0, 1)) Then 'Wenn in Zelle E gleiche Zeile ein Zahl steht
'Mit SUMIFS den Faktor bestimmen
varRet = Application.SumIfs(.Columns(4), .Columns(3), rng.Offset(0, -1), .Columns(2), _
rng.Offset(0, -2), .Columns(1), rng.Offset(0, -3))

If IsNumeric(varRet) Then 'Wenn der Faktor ermittelt wurde
'Berechnung in Zelle Eintragen
rng.Offset(0, 4) = (rng.Offset(0, 1) / 100 + rng.Offset(0, 2)) * varRet
End If
End If
ElseIf LCase(rng) = "nein" Then
rng.Offset(0, 4) = 0
End If
Next
End With

End Sub