Excel-Makro

[Scindapsus]

Hallo,

wie kann man folgende Problematik mit einem Excel-Makro lösen?

Ergänzung, 8:30 Uhr:
Das Makro soll die Summen der Hauptpositionen (Position 1, Position 2) und die Summen der Unterpositionen (Poisition 1.1, Position 1.2, Position 1.3, Position 2.1) berechnen, wobei sich die Summe der Hauptpositionen aus den Summen der Unterpositionen bildet.

 

[Scindapsus]

Hat denn wirklich niemand eine Idee?

Ich dachte irgendwie an eine Schleife, welche die Tabelle von der ersten bis zur letzten Zeile durchgeht und dabei die Summen bildet.

Nur wie?

 

[Marvin_X]

Wie wäre es denn ganz einfach die Summen der Position 1,2,3 und die der 1.1,1.2 in verschiedenen Spalten zu schreiben?

 

[Scindapsus]

Hallo Marvin_X,

die Summen in extra Spalten zu schreiben - Danke ein Denkanstoß.
Nur muss ich die unterschiedlichen Summen erst einmal bilden können.

In den Formularen sind nur die schwarzen Werte vorgegeben.
Aus denen sollen dann die blauen Werte berechnet werden
und aus den blauen Werten dann die roten Werte.

 

[Janush]

Hi,

bau doch einfach ne =sumif() Formel mit ? als Platzhalter, oder soll das tatsaechlich nur per Makro geloest werden?

mfg

 

[Scindapsus]

Hallo Janush,

nur per Makro, da der Aufbau der Formulare (bezüglich der Anzahl der Positionen) immer unterschiedlich ist.

 

[Janush]

aha. wie sieht denn die datenquelle aus. kann mir gerade noch nicht vorstellen wie der ursprung aussieht und wie das makro da eingebunden werden soll um im endeffekt diese tabelle zu erhalten.

 

[Scindapsus]

Hallo Janush,

angefügt findest du die Datenquelle.

Mein bisheriger Quellcode schaut wie folgt aus:

Private Sub cmd_Summe_Click()
    Dim zeilen, anzPos, i As Integer
    Dim summe As Double
    
    'Ermittle die letzte, mit einem Wert beschriebene Zelle = Zeilenanzahl
    zeilen = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row
    If zeilen <> 0 Then
        MsgBox "Die letzte Zeile, die einen Wert beinhaltet, ist Zeile " & zeilen, vbInformation, "Information Zeilenanzahl"
        
        'Das Maximum in Spalte B ermitteln = Anzahl der Positionen
        anzPos = WorksheetFunction.Max(Range(Cells(1, 2), Cells(zeilen, 2)))
        
        'Die Gesamtsumme berechnen
        summe = 0
        i = 1
        Do Until i > zeilen
            summe = summe + Cells(i, 6)
            i = i + 1
        Loop
        Cells(5, 10) = summe
        Cells(6, 10) = anzPos
    End If
End Sub

 

[Janush]

sorry war gerade mittag machen. eine rein makro basierte loesung ist schon etwas schwieriger. ich mach mir mal ein paar gedanken dazu. kann aber nichts versprechen, muss nebenbei arbeiten :-)

Ergänzung (2. August 2011)

das sind so meine gedanken dazu. funktioniert aber nur wenn die logische abfolge eingehalten wird. also die gesamtsumme muss immer oben stehen.

Sub test()
Dim x As Integer
Dim y As Integer
Dim schluessel As String


For x = 1 To ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row
    If Cells(x, 6) = "" Then
        If Cells(x, 3) = 0 And Cells(x, 4) = 0 Then schluessel = Cells(x, 2) & " # #"
        If Cells(x, 3) <> 0 And Cells(x, 4) = 0 Then schluessel = Cells(x, 2) & " " & Cells(x, 3) & " #"
        
        For y = 1 To ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row
            Cells(y, 8) = Trim(Str(Cells(y, 2)) & Str(Cells(y, 3)) & Str(Cells(y, 4)))
            If Trim(Str(Cells(y, 2)) & Str(Cells(y, 3)) & Str(Cells(y, 4))) Like schluessel Then Cells(x, 6) = Cells(x, 6) + Cells(y, 6)
        Next y
    End If
Next x



End Sub

 

[Scindapsus]

Hallo Janush,

dein Quellcode funktioniert 1A! DANKE!
Kannst du ihn für mich bitte noch kommentieren?
Vielleicht gelingt es mir ja dann auch, den Quellcode so anzupassen, dass es mit einer unterschiedlichen Anzahl an Positionen klappt...

 

[Janush]

hey,

sollte eigentlich mit beliebiger anzahl an positionen funktionieren, solange die "mutterposition" immer oben steht.

zum kommentieren hab ich eigentlich keinen bock. ich finde das kurze stueck ist selbsterklaerend.

die funktionesweise ist simpel. wenn das makro in einer leeren zelle ankommt wird ein "navigationsschluessel" erstellt. in zeile eins waere das dann "1 # #". danach werden alle weiteren zeilen damit verglichen "like" und ist die bedingung "true" wird aufsummiert.

das grosse problem dabei ist, dass 1 1 0 dem auch entspricht. heist 1 1 0 ist auch "like" 1 # #.

wenn du einen weg findest das zu umgehen/loesen. sollte es auch universelleinsetzbar sein, soll heisen die "mutterposition" darf dann auch unten sitzen :-)

viel spass beim entwickeln, mir ist auf die schnelle dazu keine loesung eingefallen.

gruss
Martin

 

[Scindapsus]

Hallo Janush,

nach genauerer Betrachtung habe ich den Quellcode verstanden.
Immerhin muss ich dazu schreiben, dass dies mein erstes Excel-Makro ist.

Nun eine weitere Frage:
Wo muss ich im Quellcode Anpassungen vornehmen, damit auch Positionen mit höheren Zahlwerten zusammenaddiert werden?
Also z.B.
Position 1.1
mit den Unterpositionen
1.1.1 bis 1.1.20
oder
Position 10.2
mit den Unterpositionen
10.2.1 bis 10.2.12
?

Ich habe schon probiert anstelle einer # zwei (also ##) einzugeben, aber das funktioniert nicht.
Noch eine Idee?

Ich habe noch einen Button "Summen löschen" ergänzt:

Private Sub cmd_Loeschen_Click()
    Dim startzeile, x, y As Integer
    Dim schluessel As String
    
    startzeile = 1
    
    'Daten bis zur letzten Zeile einlesen
    For x = startzeile To ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row
        'Wenn die entsprechenden Zellen in Spalte C und D = 0 sind,
        'dann lösche die entsprechende Zelle in Spalte F
        If Cells(x, 3) = 0 And Cells(x, 4) = 0 Then
            Cells(x, 6) = ""
        'Wenn die entsprechende Zelle in Spalte D = 0 ist,
        'dann lösche die entsprechende Zelle in Spalte F
        ElseIf Cells(x, 3) <> 0 And Cells(x, 4) = 0 Then
            Cells(x, 6) = ""
        End If
        Cells(x, 8) = ""
    Next x
End Sub

 

[Janush]

Moin,

also wenn Du jetzt noch deine cmd_Loeschen_Click erweiterst das sie auch die Nullen loescht, dann kannst Du das andere Macro umbauen das es richtig zaehlt.

Ungefaehr so: wenn zelle x,3 und x,4 = 0 oder zelle x,3 und x,4 = "" dann zelle x,3 und zelle x,4 und zelle x,6 = ""

wenn du das hast veraenderst du den nav schluessel wiefolgt:

If Cells(x, 3) = "" And Cells(x, 4) = "" Then schluessel = Cells(x, 2) & " * *"
If Cells(x, 3) <> "" And Cells(x, 4) = "" Then schluessel = Cells(x, 2) & " " & Cells(x, 3) & " *"

Ich habe das jetzt nicht ausprobiert, da ich das File schon wieder verworfen habe. Versuchs einfach mal :-)

Ergänzung (4. August 2011)

und immer schoen die leerzeichen im schluessel beachten. eigentlich kannst du auch beide makros zu einem zusammenfuegen.

erst loeschen dann rechnen.

 

[Scindapsus]

Hallo,

wieso bringt Excel beim Ausführen folgendes Codes

   Dim x As Integer
   Dim summe As Double
   'Gesamtsumme bilden
    summe = 0
    x = 17
    Do Until x > zeilen
        summe = summe + Cells(x, 9).Value
        x = x + 1
    Loop
    Cells(14, 9) = summe

die Meldung:
Laufzeitfehler '13':
Typen unverträglich

Ich muss dazu schreiben, dass in Zelle(x, 9) eine Formel steht.
Greift man mit .Value nicht auf den Zellwert zu?

 

[Janush]

Hi,

also bei mir funktionierts. Wie sieht denn der Rest aus? Was steckt hinter der Variable "zeilen"? Was ist das fuer eine Formel in X,9?

 

[Scindapsus]

Habe es jetzt ganz anders gelöst (angepasst an ein anderes Original):

'Bereich festlegen
Const startrange As Integer = 17
Const endrange As Integer = 1191


Private Sub cmd_Summe_Click()
    Dim zeilen, x, i_search, i As Integer
       
    'letzte, in die Rechnung eingehende Zeile, ermitteln
    zeilen = WorksheetFunction.CountIf(Range(Cells(startrange, 2), Cells(endrange, 2)), "<>" & 0) + startrange
    
    'Gesamtsumme bilden
    Cells(14, 9) = WorksheetFunction.SumIf(Range(Cells(startrange, 2), Cells(zeilen, 2)), 2, _
                                           Range(Cells(startrange, 9), Cells(zeilen, 9)))
    
    'Summen bilden und ausgeben
    i = startrange
    Do Until i > zeilen
        If Cells(i, 3).Value <> 0 And Cells(i, 4).Value = 0 Then
            i_search = Cells(i, 3).Value
            Cells(i, 9) = WorksheetFunction.SumIf(Range(Cells(i, 3), Cells(zeilen, 3)), i_search, _
                                                  Range(Cells(i, 9), Cells(zeilen, 9)))
            i = i + (WorksheetFunction.SumIf(Range(Cells(i, 3), Cells(zeilen, 3)), i_search, _
                                             Range(Cells(i, 3), Cells(zeilen, 3))) / i_search)
        ElseIf Cells(i, 3).Value = 0 And Cells(i, 4).Value = 0 Then
            i_search = Cells(i, 2).Value
            Cells(i, 9) = WorksheetFunction.SumIf(Range(Cells(i, 2), Cells(zeilen, 2)), i_search, _
                                                  Range(Cells(i, 9), Cells(zeilen, 9)))
            i = i + 1
        Else
            i = i + 1
        End If
    Loop
End Sub

Jetzt jedoch noch eine ganz andere Frage:
Kann ich eine Sub-Routine in einer anderen Sub-Routine aufrufen?
Also z.B. eine im Code deklarierte

Private Sub cmd_Loeschen_Click()

in

Private Sub cmd_Summe_Click()
     'hier soll der Aufruf der cmd_Loeschen_Click() erfolgen
End Sub

aufrufen?

Mit call hat es nicht funktioniert.

Ergänzung:
Es funktioniert mit call, wenn die Sub-Methoden auf Public gestellt sind.

Ergänzung (15. August 2011)

Warum führt:

Dim i_search_B, i_search_C, i As Integer

Cells(i, 9) = WorksheetFunction.SumProduct((Range(Cells(i, 2), Cells(zeilen, 2)) = i_search_B) * (Range(Cells(i, 3), Cells(zeilen, 3)) = i_search_C) * (Range(Cells(i, 9), Cells(zeilen, 9))))

zur Fehlermeldung:
Laufzeitfehler '13': Typen unverträglich
?

In den Spalten B und C sind jeweils nur Integer hinterlegt und in Spalte I Double-Werte.
Liegt es daran?

Ergänzung (16. August 2011)

Wie kann ich die Funktion SumProduct zur Berechnung der Summe Position 1.1 anwenden?

Folgender Quellcode

Cells(4, 9) = WorksheetFunction.SumProduct(Range("B4:B27") = 1 * _
                                               Range("C4:C27") = 1 * _
                                               Range("I4:I27"))

führt zur Fehlermeldung:
Laufzeitfehler '13': Typen unverträglich

Was ist falsch?

Später wird die Formel mit Variablen angepasst, aber dazu soll die einfache Formel erst einmal funktionieren...

 

[Scindapsus]

Habe es nun doch gelöst.
Die Lösung des Problems liegt in der Funktion SumIfs (welche jedoch nur ab Excel 2007 verfügbar ist).

Cells(i, 9) = WorksheetFunction.SumIfs(Range(Cells(i, 9), Cells(zeilen, 9)), _
                                                          Range(Cells(i, 2), Cells(zeilen, 2)), Cells(i, 2).Value, _
                                                          Range(Cells(i, 3), Cells(zeilen, 3)), Cells(i, 3).Value)