Live-Forum - Die aktuellen Beiträge
Anzeige
Archiv - Navigation
1120to1124
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

Makro erweiteren für weitere Spalten

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

1
Beitrag zum Forumthread
Beitrag zu diesem Forumthread

Betreff
Benutzer
Anzeige
AW: Makro erweiteren für weitere Spalten
27.11.2009 14:08:50
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
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige