Microsoft Excel

Herbers Excel/VBA-Archiv

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


Betrifft: Makro erweitern für weitere Spalten von: Henning
Geschrieben am: 11.12.2009 15:04:09

Hallo zusammen,
ich hatte vor einiger Zeit ein ähnliches Problem und ransi hat mir dabei geholfen.

Wenn einer von euch ransi kennt könnt ihr ihm bitte Bescheid geben.

Denn ich habe folgendes Problem.
ich habe folgende Auswertung: https://www.herber.de/bbs/user/66225.xls

Und das Makro sieht so aus. und funktioniert !!!!! Soll heißen, die Summen werden korrekt angezeigt.

Nur wenn ich vor der Spalte E noch eine Spalte einfüge und das Makro so anpassen wie hier: https://www.herber.de/bbs/user/66527.xls

Dann wird die Summe nicht mehr richtig gebildet. Habe ich einen Denkfehler oder bin ich zu doof.

Schon einmal vorab vielen Dank und ein schönes Wochende.

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
Grüße
Henning

  

Betrifft: Makro rechnet m.E. nicht falsch ! von: NoNet
Geschrieben am: 11.12.2009 17:37:21

Hallo Henning,

ich habe das Makro eben mal in der erweiterten Tabelle laufen lassen : Die Ergebnisse sind korrekt !

Das kann man per Tabellenblattfunktion überprüfen (z.B. in B15 eingeben und dann runterkopieren) :

=SUMMEWENN($C$15:$C$66;C15&"*";$F$15:$F$66)

Hier ein Screenshot des Ergebnisses (Prüfungsfunktionen in Grünen Spalten, Spalten L:P enthalten die ursprünglichen Originalwerte) :



Das einzige was an Deiner hochgeladenen Mappe merkwürdig war :
Der Makrocode war in einem falschen Format, genauer die TABS vor jeder Codezeile !
Diese musste ich erst durch "echte" Tabs ersetzen, damit der Code gestartet werden konnte !

Gruß, NoNet


  

Betrifft: AW: Makro rechnet m.E. nicht falsch ! von: Henning
Geschrieben am: 11.12.2009 18:08:36

Hallo NoNet,

sorry, da habe ich mich verkehrt ausgedrückt.

Das Makro rechnet dann falsch wenn ich noch eine Spalte, z.B. zum Komentieren

Das Beispiel und den Code findest du hier

https://www.herber.de/bbs/user/66527.xls

Danke und Gruß
Henning


  

Betrifft: AW: Makro rechnet m.E. nicht falsch ! von: Luschi
Geschrieben am: 11.12.2009 21:36:44

Hallo Henning,

NoNet hatte schon darauf hingewiesen, daß mit dem Vba-Makro etwas nicht stimmt. Wenn ich Deine Datei öffne und mir das Makro ansehe, so sind manche Zeilen rot dargestellt.
In dieser (roten) Zeile '    If arr(L, 3) = "" Then' sind die ersten 4 Zeichen keine Leerzeichen (ASCII-Code 32) sondern entsprechen dem ASCII-Code 160. Was soll das; womit schreibst Du den Vba-Code.
Das Makro kann überhaupt nicht funktionieren.

Gruß von Luschi
aus klein-Paris


  

Betrifft: Spalten variabilisieren von: NoNet
Geschrieben am: 11.12.2009 22:33:56

Hallo Henning,

damit das Makro auch bei eingefügten Spalten noch richtig funktioniert, musst Du die Bezüge anpassen.
Ich habe das mal in Abhängigkeit der Beschriftung "Budget" gemacht, das Makro funktioniert nun bei 1,2,3,4,... eingefügten Spalten vor "Budget" :

Sub VariableSpalten()
    Dim Arr As Variant, lngLS As Long, lngS As Long
    Dim rngBereich As Range, rngPSP As Range
    Dim L As Long
    
    lngS = Application.Match("Budget", Rows("14:14"), 0) - 5 'Sucht "Budget" in Zeile 15
    lngLS = Cells(14, Columns.Count).End(xlToLeft).Column
    
    Set rngPSP = Range("C15").CurrentRegion.Offset(1).Resize(10000, 1)
    Set rngBereich = Range("C15").CurrentRegion.Offset(1).Resize(10000, lngLS - 1)
    Arr = rngBereich
    
    For L = 1 To UBound(Arr)
        If Arr(L, 3 + lngS) = "" Then
            Arr(L, 3 + lngS) = WorksheetFunction.SumIf(rngPSP, Arr(L, 1) & ".*", _
                    Range("E15:E10000").Offset(, lngS))
            Arr(L, 4 + lngS) = WorksheetFunction.SumIf(rngPSP, Arr(L, 1) & ".*", _
                    Range("F15:F10000").Offset(, lngS))
            Arr(L, 5 + lngS) = WorksheetFunction.SumIf(rngPSP, Arr(L, 1) & ".*", _
                    Range("G15:G10000").Offset(, lngS))
            Arr(L, 6 + lngS) = WorksheetFunction.SumIf(rngPSP, Arr(L, 1) & ".*", _
                    Range("H15:H10000").Offset(, lngS))
            If Arr(L, 3 + lngS) = 0 Then Arr(L, 3 + lngS) = ""
            If Arr(L, 4 + lngS) = 0 Then Arr(L, 4 + lngS) = ""
            If Arr(L, 5 + lngS) = 0 Then Arr(L, 5 + lngS) = ""
            If Arr(L, 6 + lngS) = 0 Then Arr(L, 6 + lngS) = ""
        End If
    Next
    'Range("C15:H10000") = Arr
    rngBereich = Arr
End Sub
Gruß, NoNet


  

Betrifft: AW: Spalten variabilisieren von: Henning
Geschrieben am: 12.12.2009 07:15:09

Guten Morgen, NoNet,

super vielen Dank !!!!!

Jetzt kann ich weitermachen.

Gruß

Henning


  

Betrifft: AW: Spalten variabilisieren von: Henning
Geschrieben am: 12.12.2009 09:16:43

Moin NoNet,
mir ist aufgefallen, dass nach dem Aufsummieren Zahlen verschwunden sind in den Spalten IST und Obligo.
Weißt du vielleicht voran das liegt.
Die Summen stimmen.

Vielen Dank im Voraus
Grzß
Henning


  

Betrifft: Nööö - bei mir verschwinden keine Zahlen von: NoNet
Geschrieben am: 12.12.2009 11:16:07

Hallo Henning,

zumindest in der Datei, die Du uns zur Verfügung gestellt hast, verschwinden keine Zahlen.
Hier das Ergebnis NACH dem Makro-Durchlauf : Spalten J:K enthalten zum Vergleich die Werte VOR dem Makro-Durchlauf - es besteht kein Unterschied :

HIJK
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67

Tabelle eingefügt mit Syntaxhighlighter 4.15

Gruß, NoNet


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