HERBERS Excel-Forum - das Archiv
Bewerten Sie hier bitte das Excel-Portal

Thema: Makro erweiteren für weitere Spalten | Herbers Excel-Forum

Makro erweiteren für weitere Spalten
Henning

Hallo zusammen,
ich habe folgendes Makro:
Option Explicit
Public Sub test()
Dim arr As Variant
Dim L As Long
arr = Range("C15:D10000")
For L = 1 To UBound(arr)
If arr(L, 2) = "" Then _
arr(L, 2) = WorksheetFunction.SumIf(Range("C15:C10000"), arr(L, 1) & ".*", Range("D15: _
D10000"))
If arr(L, 2) = 0 Then arr(L, 2) = ""
Next
Range("C15:D10000") = arr
End Sub

Dieses Makro funktioniert einwandfrei im Beispiel 1 (siehe unten).
Die Spalte H zeigt wie die Daten vor dem Ausführen des Makros aussehen. So erhalte ich die Daten aus SAP heraus und ich benötige die Summen und Teilergebnisse.
Beispiel 1 https://www.herber.de/bbs/user/66224.xls
Was ich aber benötige, dass ist in Beispiel 2 (siehe unten) abgebildet. Wie kann ich das Makro anpassen damit ich auch die Summen in den Spalten E, F, G und H bekomme.
Beispiel 2 https://www.herber.de/bbs/user/66225.xls
Vielen Dank im Voraus
Beste Grüße
Henning

AW: Makro erweiteren für weitere Spalten
ransi

HAllo HEnning
Schau mal dies:
Option Explicit

Public Sub test()
Dim arr As Variant
Dim L As Long
arr = Range("C15:H10000")
For L = 1 To UBound(arr)
    If arr(L, 3) = "" Then
        arr(L, 3) = WorksheetFunction.SumIf(Range("C15:C10000"), arr(L, 1) & ".*", Range("E15:E10000"))
        arr(L, 4) = WorksheetFunction.SumIf(Range("C15:C10000"), arr(L, 1) & ".*", Range("F15:F10000"))
        arr(L, 5) = WorksheetFunction.SumIf(Range("C15:C10000"), arr(L, 1) & ".*", Range("G15:G10000"))
        arr(L, 6) = WorksheetFunction.SumIf(Range("C15:C10000"), arr(L, 1) & ".*", Range("H15:H10000"))
        If arr(L, 3) = 0 Then arr(L, 3) = ""
        If arr(L, 4) = 0 Then arr(L, 4) = ""
        If arr(L, 5) = 0 Then arr(L, 5) = ""
        If arr(L, 6) = 0 Then arr(L, 6) = ""
    End If
Next
Range("C15:H10000") = arr
End Sub


ransi