Live-Forum - Die aktuellen Beiträge
Datum
Titel
29.03.2024 13:14:12
28.03.2024 21:12:36
28.03.2024 18:31:49
Anzeige
Archiv - Navigation
1544to1548
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

Teilsumme jeder Spalte mit Überschrift "X" und "Y"

Teilsumme jeder Spalte mit Überschrift "X" und "Y"
27.02.2017 14:45:40
Kaan
Guten Tag liebe VBA Experten!
Ich verzweifle ein wenig an der vor mir liegenden Aufgabe und hoffe, dass ich hier vielleicht eine Lösung finde.
Jeden Monat wird eine Tabelle um 2 Spalten ergänzt. Diese Spalten sind 70 Zeilen lang und haben als Überschrift "X" und "Y".
Was ich versuche, ist die Teilsumme jeder einzelnen Spalte, die die Überschrift "X" oder "Y" trägt, zu errechnen und diese unter die entsprechende Spalte zu schreiben(es gibt mehrere Spalten mit der Überschrift "X" oder "Y")
Die Überschriften sind immer gleich und stehen immer in Zeile 2.
Um zu verdeutlichen was ich mir vorgestellt habe:
1) Suche in Zeile 2 nach Überschrift "X" und "Y"
2) Wenn Überschrift = "X" oder "Y" dann
Springe zur letzten genutzten Zelle der Spalte
Gehe 2 Zellen weiter runter 'hat den Sinn, eine Zeile Platz zu lassen und das Ergebnis in die nächste Zeile zu schreiben
Berechne die Teilsumme der Spalte
3) Wiederhole dies für jede Spalte mit Überschrift "X" und "Y"
Ich habe zwar einen Code der das tut was ich möchte, nur leider tut er das immer nur für die ersten beiden Spalten mit den Überschriften, er müsste das aber für jede Spalte mit besagten Überschriften tun.
Option Explicit

Sub Suchen()
Dim rZelleX As Range
Dim rZelleY As Range
Dim sSuchbegriffX  As String: sSuchbegriffX = "X"
Dim sSuchbegriffY  As String: sSuchbegriffY = "Y"
Dim Zelle As Range
With ActiveSheet.Rows(Range("A2").Row)
Set rZelleX = .Find(What:=sSuchbegriffX, lookat:=xlWhole, LookIn:=xlValues, _
SearchOrder:=xlByRows)
Set rZelleY = .Find(What:=sSuchbegriffY, lookat:=xlWhole, LookIn:=xlValues, _
SearchOrder:=xlByRows)
End With
rZelleX.End(xlDown).Offset(2, 0).ActiveCell.FormulaR1C1 = "=SUBTOTAL(9,R[-66]C:R[-2]C)"
rZelleY.End(xlDown).Offset(2, 0). ActiveCell.FormulaR1C1 = "=SUBTOTAL(9,R[-66]C:R[-2]C)"
End Sub

Ich würde mich sehr über eure Hilfe freuen!
Mit freundlichen Grüßen,
Kaan

4
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Teilsumme jeder Spalte mit Überschrift "X" und "Y"
27.02.2017 18:54:03
Piet
Hallo Kaan,
anbei dein überarbeitetes Makro zurück, das diese Aufgabe lösen sollte
mfg Piet
Sub Suchen()
Dim rZelleX As Range
Dim rZelleY As Range
Dim sSuchX  As String: sSuchX = "X"
Dim sSuchY  As String: sSuchY = "Y"
Dim Zelle As Range
Dim col As Integer, nAdr As String  'Column, Next Adresse
With ActiveSheet.Rows(Range("A2").Row)
Set rZelleX = .Find(What:=sSuchX, After:=Range("A2"), LookIn:=xlValues, _
LookAt:=xlWhole, SearchDirection:=xlNext)
Do  'X Schleife
col = rZelleX.Column
nAdr = rZelleX.Address
rZelleX.End(xlDown).Offset(2, 0).FormulaR1C1 = "=SUBTOTAL(9,R[-66]C:R[-2]C)"
Set rZelleX = .FindNext(After:=Range(nAdr))
Loop Until col > rZelleX.Column
Set rZelleY = .Find(What:=sSuchY, After:=Range("A2"), LookIn:=xlValues, _
LookAt:=xlWhole, SearchDirection:=xlNext)
Do  'Y Schleife
col = rZelleY.Column
nAdr = rZelleY.Address
rZelleY.End(xlDown).Offset(2, 0).FormulaR1C1 = "=SUBTOTAL(9,R[-66]C:R[-2]C)"
Set rZelleY = .FindNext(After:=Range(nAdr))
Loop Until col > rZelleY.Column
End With
End Sub

Anzeige
AW: Teilsumme jeder Spalte mit Überschrift "X","Y"
28.02.2017 09:07:56
Kaan
Hallo Piet, vielen Dank für deine Antwort!
Leider verläuft deine Lösung in eine Endlosschleife, mit der Excel dann nicht mehr ansprechbar ist.
Das Problem liegt im Loop, ich weiß aber nicht wie ich die Loop Bedingung ändern muss um das Ergebnis zu erzielen und eine Endlosschleife zu vermeiden.
(Sowohl "größer als >" als auch "kleiner als Mit freundlichen Grüßen,
Kaan
AW: Teilsumme jeder Spalte mit Überschrift "X","Y"
28.02.2017 13:50:28
Piet
Hallo,
Sorry wenn es nicht auf Anhieb klappt, dann probieren wir eine andere Loop Variante aus.
Hier vergleiche ich ich ob die LastColumn in Zeile 2 erreicht wurde. Ich hoffe so klappt es!
mfg Piet
Sub Suchen()
Dim rZelleX As Range
Dim rZelleY As Range
Dim sSuchX  As String: sSuchX = "X"
Dim sSuchY  As String: sSuchY = "Y"
Dim Zelle As Range
Dim col As Integer, nAdr As String   'Column, Next Adresse
Dim colN As Integer, Adr1 As String  'neu eingefügt  28.2.
With ActiveSheet.Rows(Range("A2").Row)
nAdr = Cells(2, Columns.Count).Address
Set rZelleX = .Find(What:=sSuchX, After:=Range("A2"), LookIn:=xlValues, _
LookAt:=xlWhole, SearchDirection:=xlNext)
'X LastColumn ermitteln
colN = .Find(What:=sSuchX, After:=Range(nAdr), LookIn:=xlValues, _
LookAt:=xlWhole, SearchDirection:=xlPrevious).Column
'X Schleife bis LastColumn
Do Until col = colN
col = rZelleX.Column
nAdr = rZelleX.Address
rZelleX.End(xlDown).Offset(2, 0).FormulaR1C1 = "=SUBTOTAL(9,R[-66]C:R[-2]C)"
Set rZelleX = .FindNext(After:=Range(nAdr))
Loop
nAdr = Cells(2, Columns.Count).Address
Set rZelleY = .Find(What:=sSuchY, After:=Range("A2"), LookIn:=xlValues, _
LookAt:=xlWhole, SearchDirection:=xlNext)
'X LastColumn ermitteln
colN = .Find(What:=sSuchY, After:=Range(nAdr), LookIn:=xlValues, _
LookAt:=xlWhole, SearchDirection:=xlPrevious).Column
'X Schleife bis LastColumn
Do Until col = colN
col = rZelleY.Column
nAdr = rZelleY.Address
rZelleY.End(xlDown).Offset(2, 0).FormulaR1C1 = "=SUBTOTAL(9,R[-66]C:R[-2]C)"
Set rZelleY = .FindNext(After:=Range(nAdr))
Loop
End With
End Sub

Anzeige
AW: Teilsumme jeder Spalte mit Überschrift "X","Y"
28.02.2017 14:47:57
Kaan
Hey Piet, kein Grund zur Entschuldigung! Immerhin opferst du mir hier deine wertvolle Zeit und alles was ich dir dafür geben kann ist ein Danke!
Dein neuer Code funktioniert super!
Ich habe zwar Probleme damit ihn in meinen Mastercode zu implementieren, aber das werde ich schon hinbekommen.
Nochmals vielen Dank für deine ausführliche Hilfe Piet!
Mit freundlichen Grüßen,
Kaan

297 Forumthreads zu ähnlichen Themen

Anzeige
Anzeige
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige