Live-Forum - Die aktuellen Beiträge
Anzeige
Archiv - Navigation
412to416
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
412to416
412to416
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Inhaltsverzeichnis

Makro setzt automatische Summenbildung aus

Makro setzt automatische Summenbildung aus
Eva
Hallo,
über ein einfaches Makro sortiere ich mir Daten in einem separaten Excel Sheet. Mit dem Durchlauf des Makros wird bei durch das Makro nicht angesprochenen Zellen, bei denen eine Summenfunktion hinterlegt ist, die Summenfunktion rausgenommen.
Gibt es eine elegante Lösung, über die mir die Summenfunktion automatisch erhalten bleibt, ohne dass extra ein "Summen"makro in der Schleife einzufügen ist?
hier das Makro:

Private Sub ComboBox2_Change()
fuellen
End Sub


Private Sub fuellen()
leeren
z = 3
kst = ComboBox1.Value
kst2 = ComboBox2.Value
Do Until ActiveWorkbook.Worksheets("Übersetzer für HC-Report").Cells(z, 1) = "Ges"
If ActiveWorkbook.Worksheets("Übersetzer für HC-Report").Cells(z, 1) = kst Then
Do
For s = 3 To 33
If s = 28 Then ActiveWorkbook.Worksheets("Kst_Zuordnung_Bereich").Cells(8, 3) = ActiveWorkbook.Worksheets("Kst_Zuordnung_Bereich").Cells(8, 3) + ActiveWorkbook.Worksheets("Übersetzer für HC-Report").Cells(z, s)
If s = 27 Then ActiveWorkbook.Worksheets("Kst_Zuordnung_Bereich").Cells(9, 3) = ActiveWorkbook.Worksheets("Kst_Zuordnung_Bereich").Cells(9, 3) + ActiveWorkbook.Worksheets("Übersetzer für HC-Report").Cells(z, s)
If s = 26 Then ActiveWorkbook.Worksheets("Kst_Zuordnung_Bereich").Cells(10, 3) = ActiveWorkbook.Worksheets("Kst_Zuordnung_Bereich").Cells(10, 3) + ActiveWorkbook.Worksheets("Übersetzer für HC-Report").Cells(z, s)
If s = 33 Then ActiveWorkbook.Worksheets("Kst_Zuordnung_Bereich").Cells(11, 3) = ActiveWorkbook.Worksheets("Kst_Zuordnung_Bereich").Cells(11, 3) + ActiveWorkbook.Worksheets("Übersetzer für HC-Report").Cells(z, s)
If s = 32 Then ActiveWorkbook.Worksheets("Kst_Zuordnung_Bereich").Cells(12, 3) = ActiveWorkbook.Worksheets("Kst_Zuordnung_Bereich").Cells(12, 3) + ActiveWorkbook.Worksheets("Übersetzer für HC-Report").Cells(z, s)
If s = 31 Then ActiveWorkbook.Worksheets("Kst_Zuordnung_Bereich").Cells(13, 3) = ActiveWorkbook.Worksheets("Kst_Zuordnung_Bereich").Cells(13, 3) + ActiveWorkbook.Worksheets("Übersetzer für HC-Report").Cells(z, s)
If s = 30 Then ActiveWorkbook.Worksheets("Kst_Zuordnung_Bereich").Cells(14, 3) = ActiveWorkbook.Worksheets("Kst_Zuordnung_Bereich").Cells(14, 3) + ActiveWorkbook.Worksheets("Übersetzer für HC-Report").Cells(z, s)
If s = 11 Then ActiveWorkbook.Worksheets("Kst_Zuordnung_Bereich").Cells(17, 3) = ActiveWorkbook.Worksheets("Kst_Zuordnung_Bereich").Cells(16, 3) + ActiveWorkbook.Worksheets("Übersetzer für HC-Report").Cells(z, s)
If s = 10 Then ActiveWorkbook.Worksheets("Kst_Zuordnung_Bereich").Cells(18, 3) = ActiveWorkbook.Worksheets("Kst_Zuordnung_Bereich").Cells(17, 3) + ActiveWorkbook.Worksheets("Übersetzer für HC-Report").Cells(z, s)
If s = 9 Then ActiveWorkbook.Worksheets("Kst_Zuordnung_Bereich").Cells(19, 3) = ActiveWorkbook.Worksheets("Kst_Zuordnung_Bereich").Cells(18, 3) + ActiveWorkbook.Worksheets("Übersetzer für HC-Report").Cells(z, s)
If s = 7 Then ActiveWorkbook.Worksheets("Kst_Zuordnung_Bereich").Cells(22, 3) = ActiveWorkbook.Worksheets("Kst_Zuordnung_Bereich").Cells(20, 3) + ActiveWorkbook.Worksheets("Übersetzer für HC-Report").Cells(z, s)
If s = 6 Then ActiveWorkbook.Worksheets("Kst_Zuordnung_Bereich").Cells(23, 3) = ActiveWorkbook.Worksheets("Kst_Zuordnung_Bereich").Cells(21, 3) + ActiveWorkbook.Worksheets("Übersetzer für HC-Report").Cells(z, s)
If s = 4 Then ActiveWorkbook.Worksheets("Kst_Zuordnung_Bereich").Cells(24, 3) = ActiveWorkbook.Worksheets("Kst_Zuordnung_Bereich").Cells(22, 3) + ActiveWorkbook.Worksheets("Übersetzer für HC-Report").Cells(z, s)
If s = 5 Then ActiveWorkbook.Worksheets("Kst_Zuordnung_Bereich").Cells(25, 3) = ActiveWorkbook.Worksheets("Kst_Zuordnung_Bereich").Cells(23, 3) + ActiveWorkbook.Worksheets("Übersetzer für HC-Report").Cells(z, s)
If s = 3 Then ActiveWorkbook.Worksheets("Kst_Zuordnung_Bereich").Cells(26, 3) = ActiveWorkbook.Worksheets("Kst_Zuordnung_Bereich").Cells(24, 3) + ActiveWorkbook.Worksheets("Übersetzer für HC-Report").Cells(z, s)
If s = 8 Then ActiveWorkbook.Worksheets("Kst_Zuordnung_Bereich").Cells(27, 3) = ActiveWorkbook.Worksheets("Kst_Zuordnung_Bereich").Cells(25, 3) + ActiveWorkbook.Worksheets("Übersetzer für HC-Report").Cells(z, s)
If s = 24 Then ActiveWorkbook.Worksheets("Kst_Zuordnung_Bereich").Cells(30, 3) = ActiveWorkbook.Worksheets("Kst_Zuordnung_Bereich").Cells(27, 3) + ActiveWorkbook.Worksheets("Übersetzer für HC-Report").Cells(z, s)
If s = 25 Then ActiveWorkbook.Worksheets("Kst_Zuordnung_Bereich").Cells(31, 3) = ActiveWorkbook.Worksheets("Kst_Zuordnung_Bereich").Cells(28, 3) + ActiveWorkbook.Worksheets("Übersetzer für HC-Report").Cells(z, s)
Next s
z = z + 1
Loop Until ActiveWorkbook.Worksheets("Übersetzer für HC-Report").Cells(z - 1, 1) = kst2
End If
z = z + 1
Loop
End Sub


Private Sub leeren()
ActiveWorkbook.Worksheets("Kst_Zuordnung_Bereich").Cells(8, 3) = 0
ActiveWorkbook.Worksheets("Kst_Zuordnung_Bereich").Cells(9, 3) = 0
ActiveWorkbook.Worksheets("Kst_Zuordnung_Bereich").Cells(10, 3) = 0
ActiveWorkbook.Worksheets("Kst_Zuordnung_Bereich").Cells(11, 3) = 0
ActiveWorkbook.Worksheets("Kst_Zuordnung_Bereich").Cells(12, 3) = 0
ActiveWorkbook.Worksheets("Kst_Zuordnung_Bereich").Cells(13, 3) = 0
ActiveWorkbook.Worksheets("Kst_Zuordnung_Bereich").Cells(14, 3) = 0
ActiveWorkbook.Worksheets("Kst_Zuordnung_Bereich").Cells(17, 3) = 0
ActiveWorkbook.Worksheets("Kst_Zuordnung_Bereich").Cells(18, 3) = 0
ActiveWorkbook.Worksheets("Kst_Zuordnung_Bereich").Cells(19, 3) = 0
ActiveWorkbook.Worksheets("Kst_Zuordnung_Bereich").Cells(22, 3) = 0
ActiveWorkbook.Worksheets("Kst_Zuordnung_Bereich").Cells(23, 3) = 0
ActiveWorkbook.Worksheets("Kst_Zuordnung_Bereich").Cells(24, 3) = 0
ActiveWorkbook.Worksheets("Kst_Zuordnung_Bereich").Cells(25, 3) = 0
ActiveWorkbook.Worksheets("Kst_Zuordnung_Bereich").Cells(26, 3) = 0
ActiveWorkbook.Worksheets("Kst_Zuordnung_Bereich").Cells(27, 3) = 0
ActiveWorkbook.Worksheets("Kst_Zuordnung_Bereich").Cells(30, 3) = 0
ActiveWorkbook.Worksheets("Kst_Zuordnung_Bereich").Cells(31, 3) = 0
End Sub

Vielen Dank im Voraus für Eure Hilfe.
Eva



2
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Benutzer
Anzeige
AW: Makro setzt automatische Summenbildung aus
Harald
Hallo Eva,
hier mal eine Beispielzeile, die müsstets Du entsprechend oft anwenden:
If s = 28 and not hasformula(ActiveWorkbook.Worksheets("Kst_Zuordnung_Bereich").Cells(8, 3)) Then ActiveWorkbook.Worksheets("Kst_Zuordnung_Bereich").Cells(8, 3) = ActiveWorkbook.Worksheets("Kst_Zuordnung_Bereich").Cells(8, 3) + ActiveWorkbook.Worksheets("Übersetzer für HC-Report").Cells(z, s)
Mit hasformula() prüfst Du, ob in der Zele eine Formel steht, wenn nicht, kannst DU einen Wert zuweisen, sonst bleibt die Formel bestehen.
Gruß Harald
AW: Makro setzt automatische Summenbildung aus
xXX
Hallo,
bei deinem Prob kann ich dir auch nicht weiterhelfen. Dein Code ist allerdings zu lang und zu kompliziert. Ich habe dir mal ein paar kleine Verbesserungen eingebaut, was auch die Lesbarkeit erhöht.

Private Sub ComboBox2_Change()
fuellen
End Sub


Private Sub fuellen()
Dim wksUeb As Worksheet, wksKst As Worksheet
Set wksUeb = ActiveWorkbook.Worksheets("Übersetzer für HC-Report")
Set wksKst = ActiveWorkbook.Worksheets("Kst_Zuordnung_Bereich")
leeren
z = 3
kst = ComboBox1.Value
kst2 = ComboBox2.Value
Do Until wksUeb.Cells(z, 1) = "Ges"
If wksUeb.Cells(z, 1) = kst Then
Do
For s = 3 To 33
Select Case s
Case 3: wksKst.Cells(26, 3) = wksKst.Cells(24, 3) + wksUeb.Cells(z, s)
Case 4: wksKst.Cells(24, 3) = wksKst.Cells(22, 3) + wksUeb.Cells(z, s)
Case 5: wksKst.Cells(25, 3) = wksKst.Cells(23, 3) + wksUeb.Cells(z, s)
Case 6: wksKst.Cells(23, 3) = wksKst.Cells(21, 3) + wksUeb.Cells(z, s)
Case 7: wksKst.Cells(22, 3) = wksKst.Cells(20, 3) + wksUeb.Cells(z, s)
Case 8: wksKst.Cells(27, 3) = wksKst.Cells(25, 3) + wksUeb.Cells(z, s)
Case 9: wksKst.Cells(19, 3) = wksKst.Cells(18, 3) + wksUeb.Cells(z, s)
Case 10: wksKst.Cells(18, 3) = wksKst.Cells(17, 3) + wksUeb.Cells(z, s)
Case 11: wksKst.Cells(17, 3) = wksKst.Cells(16, 3) + wksUeb.Cells(z, s)
Case 24: wksKst.Cells(30, 3) = wksKst.Cells(27, 3) + wksUeb.Cells(z, s)
Case 25: wksKst.Cells(31, 3) = wksKst.Cells(28, 3) + wksUeb.Cells(z, s)
Case 26:  wksKst.Cells(10, 3) = wksKst.Cells(10, 3) + wksUeb.Cells(z, s)
Case 27: wksKst.Cells(9, 3) = wksKst.Cells(9, 3) + wksUeb.Cells(z, s)
Case 28: wksKst.Cells(8, 3) = wksKst.Cells(8, 3) + wksUeb.Cells(z, s)
Case 30: wksKst.Cells(14, 3) = wksKst.Cells(14, 3) + wksUeb.Cells(z, s)
Case 31: wksKst.Cells(13, 3) = wksKst.Cells(13, 3) + wksUeb.Cells(z, s)
Case 32: wksKst.Cells(12, 3) = wksKst.Cells(12, 3) + wksUeb.Cells(z, s)
Case 33: wksKst.Cells(11, 3) = wksKst.Cells(11, 3) + wksUeb.Cells(z, s)
End Select
Next s
z = z + 1
Loop Until wksUeb.Cells(z - 1, 1) = kst2
End If
z = z + 1
Loop
End Sub


Private Sub leeren()
ActiveWorkbook.Worksheets("Kst_Zuordnung_Bereich").Range("c8:c14,c17:c19,c22:c27,c30:c31") = 0
End Sub

Gruß aus'm Pott
Udo
http://www.excelerator.de
Anzeige

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige