Live-Forum - Die aktuellen Beiträge
Datum
Titel
28.03.2024 21:12:36
28.03.2024 18:31:49
Anzeige
Archiv - Navigation
1848to1852
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 um summe und % erweitern

makro um summe und % erweitern
07.10.2021 08:48:54
ViktorP
Hallo Community!
Ich habe ein bestehendes Makro und möchte dies um zwei Kleinigkeiten erweitern. Drückt man auf die große Befehlsschaltfläche, so werden separate Tabellenblätter erstellt, für jeden einzelne Buchstabengruppein Spalte A.
Sobald das Makro ausgeführt ist, werden zwei neue Tabellenblätter "A" und "B" erstellt. Nun soll das Makro dahingehend erweitert werden, dass für Spalte E der jeweils neu erstellten Tabellenblätter die Summe gebildet werden soll. und die Werte in Spalte E um ein "%"-Zeichen ergänzt werden.
Die Daten die sich in Tabellenblatt GK_H sind werden über eine Access Datenbank eingespielt, das heißt, die Anzahl an Datenzeilen kann variieren bzw. die zu erstellenen Tabellenblätter mittels Makro reichen A bis Z. Kann mir jemand helfen, wie ich mein Makro erweitern kann? wo ich dazu ansetzten muss? Kenne mich im VBA leider zu wenig aus. Vielen dank für eure Hilfe!
https://www.herber.de/bbs/user/148476.xlsm

10
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: makro um summe und % erweitern
07.10.2021 09:30:26
ViktorP
Mir ist ein Fehler bei der Beschreibung unterlaufen:
*Sobald das Makro ausgeführt ist, werden zwei neue Tabellenblätter "A" und "B" erstellt. Nun soll das Makro dahingehend erweitert werden, dass für Spalte E der jeweils neu erstellten Tabellenblätter die Summe gebildet werden soll. und die Werte in Spalte d um ein "%"-Zeichen ergänzt werden.
Hoffe auf Unterstützung.
https://www.herber.de/bbs/user/148478.xlsm
AW: makro um summe und % erweitern
07.10.2021 09:34:38
Yal
Hallo Viktor,
ich kann verstehen, dass Du die "Aufgabe" bekommen hast, eine vorhandene Lösung aufrechtzuhalten, in dem neue Anforderungen hinzugefügt werden, aber es ist mMn nicht die ideale Lösungsweg.
Was Du versuchst kompliziert mit VBA zu erreichen, ist mit ein paar Klick als Pivottabelle zu haben:
Userbild
VBA raus, Flexibilität hoch und Pflegeausfwand runter. Und deine eigene Excel-Kompetenz macht ein Sprung nach vorn.
VG
Yal
Anzeige
AW: makro um summe und % erweitern
07.10.2021 10:46:23
ViktorP
Hallo Yal,
danke für deine Antwort. Eine Pivot Tabelle wäre eine super Lösung um die Daten in einem Tabelleblatt darzustellen.
Leider brauche ich pro Klasse ein separates Tabelleblat, deshalb auch das Makro.
Kannst du mir helfen das Makro zu erweitern? Ende Spalte E eine Summe, und in Spalte D das "%"-Zeichen zu ergänzen. Ich weißleider nicht wo ich ansetzten muss.
Hoffe auf Rückmeldung.
LG
ViktorP
AW: makro um summe und % erweitern
07.10.2021 15:02:44
ViktorP
Hallo Community,
kann mir dazu jemand anderer vielleicht weiterhelfen?
würde mich um Rückantwort freuen.
Liebe Grüße
ViktorP
AW: makro um summe und % erweitern
07.10.2021 15:13:16
Yal
Hallo Viktor,
es ist auch nicht verboten, eine Pivottabelle pro Blatt zu haben.
Mit einem "Seiten"-Filter hast Du im Blatt A nur die Daten von A, in B nur B, in andere nur die Summe, usw.
Es gilt immer: zuerst alle Möglichkeiten "out of the box" ausschöpfen, dann auf Sonderbehandlung (VBA) eingehen.
VG
Yal
Anzeige
AW: makro um summe und % erweitern
07.10.2021 15:18:27
ViktorP
Hallo Yal,
okay verstehe, dann werde ich das so weiterbehalten.
Kannst du mir vielleicht sagen, was ich ändern muss im Makro damit die Summenzelle pro Klasse also für A der Wert 41,19 mit in ein separates Tabellenblatt kopiert wird?
LG
ViktorP
AW: makro um summe und % erweitern
07.10.2021 16:02:47
Werner
Hallo,
schreib dir doch einfach in die Zieltabelle per Makro eine Summenformel und wandle die Formel in Ergebnisse.
Das mit den Prozent ist jetzt auch drin.

Option Explicit
Public Sub WerteVerteilen()
'Unter Extras Verweise bitte Microsoft Scripting Runtime aktivieren
Dim wsQ As Worksheet, lRow As Long, lCol As Integer, loLetzte As Long
Dim arr As Variant, dic As Object, i As Long, wert As String
Dim rngDaten As Range, rngKriterien As Range, rngAusgabe As Range
Set wsQ = Sheets("GK_H")
Set dic = CreateObject("Scripting.Dictionary")
wsQ.Cells(1, 2) = "x"
wsQ.Cells(1, 3) = "xx"
wsQ.Cells(1, 4) = "xxx"
wsQ.Cells(1, 5) = "xxxx"
lRow = Cells(Rows.Count, 2).End(xlUp).Row
lCol = 5
arr = Range(Cells(2, 1), Cells(lRow, 2))
For i = LBound(arr) To UBound(arr)
dic(arr(i, 1)) = 0
Next
arr = WorksheetFunction.Transpose(dic.Keys)
Set rngDaten = wsQ.Range(Cells(1, 1), Cells(lRow, lCol))
Set rngKriterien = wsQ.Range("J1:J2")
wsQ.Range("J1") = "Klasse"
For i = LBound(arr, 1) To UBound(arr)
wert = arr(i, 1)
If wert  "" Then
wsQ.Range("J2") = wert
Sheets.Add After:=Sheets(Sheets.Count)
ActiveSheet.Name = wert
Set rngAusgabe = ActiveSheet.Range("A1")
rngDaten.AdvancedFilter xlFilterCopy, rngKriterien, rngAusgabe
Range("B1:E1").Clear
loLetzte = Cells(Rows.Count, "E").End(xlUp).Row
Range("E2:E" & loLetzte + 1).NumberFormat = "0.00%"
Cells(1, "ZZ") = 100
Cells(1, "ZZ").Copy
Range("E2:E" & loLetzte).PasteSpecial Paste:=xlPasteValues, Operation:=xlDivide
Range("E" & loLetzte + 1).FormulaLocal = "=SUMME(E2:E" & loLetzte & ")"
Range("E" & loLetzte + 1).Value = Range("E" & loLetzte + 1).Value
Cells(1, "ZZ").ClearContents
Cells().Columns.AutoFit
End If
Next i
wsQ.Range("J1:J2").Clear
wsQ.Range("B1:E1").Clear
Set wsQ = Nothing: Set dic = Nothing: Set rngDaten = Nothing: Set rngKriterien = Nothing: Set rngAusgabe = Nothing
End Sub
Gruß Werner
Anzeige
AW: makro um summe und % erweitern
07.10.2021 17:08:03
Yal
Moin Viktor,
Man muss nicht deine Makro ergänzen, sondern diese komplett neuschreiben. Ich vermute sehr, derjenige der diese Makro hinterlassen hat, hat es aus irgendeinen Forum zusammengebastelt bekommen ohne wirklich zu verstehen, was da passiert. Nach dem Motto "ein glücklicher Chef schaut nicht unterm Teppisch".

Sub WerteVerteilen()
Dim I
Dim Z As Range
Dim wsQ As Worksheet
Dim wsZ As Worksheet
Dim dic As New Dictionary
Application.ScreenUpdating = False
'Einzel Element übertragen
Set wsQ = Worksheets("GK_H")
For Each Z In wsQ.Range(wsQ.Range("A2"), wsQ.Range("A9999").End(xlUp)).Cells
If Z.Value  "" Then
Set wsZ = Worksheet_auswählen(Z.Value)
If Not dic.Exists(wsZ.Name) Then dic.Add wsZ.Name, wsZ.Name
wsZ.Range("A1") = "Klasse"
wsZ.Range("A99999").End(xlUp).Range("A2:E2") = Z.Range("A1:E1").Value
End If
Next
'Format übertragen
wsQ.Range("A99999").End(xlUp).Range("A1:E1").Copy
For Each I In dic.Items
Set wsZ = Worksheets(I)
wsZ.Range(wsZ.Range("E2"), wsZ.Range("A99999").End(xlUp)).PasteSpecial xlPasteFormats
Next
'Summen bilden
For Each I In dic.Items
Set wsQ = Worksheets(I)
Set wsZ = Worksheet_auswählen("Summe " & I)
wsZ.Range("A1") = "Klasse Summe"
wsZ.Range("A2") = wsQ.Range("A2").Value
For Each Z In wsQ.Range(wsQ.Range("A2"), wsQ.Range("A99999").End(xlUp)).Cells
wsZ.Range("B2") = wsZ.Range("B2") + CDbl(Z.Offset(0, 4).Value)
Next
Next
Application.ScreenUpdating = True
End Sub
Private Function Worksheet_auswählen(WSName As String) As Worksheet
On Error Resume Next
Set Worksheet_auswählen = Worksheets(WSName)
If Worksheet_auswählen Is Nothing Then
Worksheets.Add After:=Sheets(Sheets.Count)
ActiveSheet.Name = WSName
Set Worksheet_auswählen = ActiveSheet
End If
End Function
VG
Yal
Anzeige
AW: makro um summe und % erweitern
08.10.2021 08:21:46
ViktorP
Guten Morgen Yal,
vielen Dank für deine Unterstützung und Hilfeleistung. Leider macht das Makro nicht ganz das gewollte. Mit dem Makro werden jetzt pro Buchstabengruppe jeweils auf einem Extra Tabellensheet die Summe erstellt. Beispielsweise Summe für Buchstabengruppe "A" in Tabellensheet "SummeA"
Die Summe pro Buchstabengruppen soll eigentlich im gleichen Tabellebnsheet sein, indem sie sich die Daten der jeweiligen Klasse befinden. D.h. in Tabellensheet "A" soll in der ersten leeren Zeille der Spalte E die Summe der darüberliegenden Werte in Spalte E errechnet werden.
Geht das irgendwie? Ich beiße mir die Zähne aus.
LG und nochmals danke schon jetzt für die Hilfe.
Anzeige
und meinen Vorschlag....
08.10.2021 09:42:34
Werner
Hallo,
...ignorierst du jetzt warum?
Gruß Werner

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige