Microsoft Excel

Herbers Excel/VBA-Archiv

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


Betrifft: Makro erweiteren für weitere Spalten von: Henning
Geschrieben am: 27.11.2009 13:22:34

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

  

Betrifft: AW: Makro erweiteren für weitere Spalten von: ransi
Geschrieben am: 27.11.2009 14:08:50

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


Beiträge aus den Excel-Beispielen zum Thema "Makro erweiteren für weitere Spalten"