Excel VBA Subtotal

Guten Tag liebe VBA Experten!
Verzeiht wenn ich irgendwelche Fehler mache, das hier wird mein erster Beitrag in so einem Forum :)
Nun zu meinem Problem:
Ich arbeite an einem Code der eine Tabelle filtern und in einem neuen Tabellenblatt auswerten soll. Bis dahin bin ich schon gekommen. Da aber alle paar Monate eine neue Tabelle kommt und sich die Spaltenzahl immer ändern kann, brauche ich einen dynamischen Code. Und hier scheitere ich seit 2 Tagen an einem Punkt:
Nachdem in meiner Tabelle 3 Spalten gefiltert wurden, soll die Teilsumme einer vierten Spalte ermittelt werden. Diese Spalte ist nicht immer an der gleichen Stelle.
Ich brauche also eine Funktion, mit der ich eine Spalte mit einer bestimmten Überschrift finde und alle Werte in dieser gefilterten Spalte addieren kann.
(Infos zur Tabelle: Sie ist zwischen 10 - 100 Spalten lang und zwischen 20.000 und 30.000 Zeilen groß, die Überschriften in Zeile 1 bleiben immer gleich)
Hier der Code den ich bis jetzt genutzt habe um 3 Spalten zu finden, zu filtern und
eine vierte Spalte (erfolglos) zu finden und zu addieren:


Sub test()
'Deklaration der Variablen
Dim dblWertAndere As Double
Dim rSN As Range
Dim rSB As Range
Dim rSM As Range
Dim rSW As Range
Worksheets("Sheet1").Activate
'Da ich mit sensiblen Daten arbeite, werde ich einige Namen/Variablen
'durch Buchstaben ersetzen
'in den folgenden Zeilen wird jeweils in der ersten Zeile nach
'bestimmten Überschriften gesucht.
Set rSN = Rows(1).Find(What:="A", LookIn:=xlValues, LookAt:=xlWhole)
Set rSB = Rows(1).Find(What:="B", LookIn:=xlValues, LookAt:=xlWhole)
Set rSM = Rows(1).Find(What:="C", LookIn:=xlValues,_
LookAt:=xlWhole)
Set rSW = Rows(1).Find(What:="Menge erfaßt gesamt", LookIn:=xlValues,_ LookAt:=xlWhole)
With Sheets("Sheet1")
.Range("A1:DA1").AutoFilter Field:=rSN.Column, Criteria1:="D"
.Range("A1:DA1").AutoFilter Field:=rSB.Column, Criteria1:="E"
.Range("A1:DA1").AutoFilter Field:=rSM.Column, Criteria1:="F"
End With
'bis zum End With funktioniert alles einwandfrei. Nun brauche ich aber
'den SUBTOTAL Wert aus der Spalte "Menge erfaßt gesamt" und hier scheitere ich
dblWertAndere = Application.WorksheetFunction.Subtotal(9, Worksheets("Sheet1").Range_(rSW)) ' _
rSW soll hier die Range der Spalte "Menge erfaßt gesamt" darstellen
'der Wert wird im folgenden auf einem zweiten Tabellenblatt abgespeichert
Sheets("Auswertung").Range("D2").Value = dblWertAndere
End Sub

Ich habe auch erst vor wenigen Wochen angefangen VBA (Excel 2007) zu erlernen, also nehmt es mir nicht übel wenn hier ein grober Fehler vorliegen sollte den ich nicht gesehen habe!
Weiterhin bin ich über jede nützliche Antwort froh und hoffe, dass ihr mir weiterhelfen könnt.
Mit freundlichen Grüßen,
Kaan

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Option Explicit Sub test() Dim dblWertAndere As Double Dim rSN As Range Dim rSB As Range Dim rSM As Range Dim rSW As Range With ThisWorkbook.Sheets("Sheet1") Set rSN = .Rows(1).Find(What:="A", LookIn:=xlValues, LookAt:=xlWhole) Set rSB = .Rows(1).Find(What:="B", LookIn:=xlValues, LookAt:=xlWhole) Set rSM = .Rows(1).Find(What:="C", LookIn:=xlValues, LookAt:=xlWhole) Set rSW = .Rows(1).Find(What:="Menge erfaßt gesamt", LookIn:=xlValues, LookAt:=xlWhole) .Range("A1:DA1").AutoFilter Field:=rSN.Column, Criteria1:="D" .Range("A1:DA1").AutoFilter Field:=rSB.Column, Criteria1:="E" .Range("A1:DA1").AutoFilter Field:=rSM.Column, Criteria1:="F" dblWertAndere = Application.Subtotal(9, .Columns(rSW.Column)) End With ThisWorkbook.Sheets("Auswertung").Cells(2, 4).Value = dblWertAndere End Sub

Sub test() Dim dblWertAndere As Double Dim rSN As Range Dim rSB As Range Dim rSM As Range Dim rSW As Range With Worksheets("Sheet1") 'Da ich mit sensiblen Daten arbeite, werde ich einige Namen/Variablen 'durch Buchstaben ersetzen 'in den folgenden Zeilen wird jeweils in der ersten Zeile nach 'bestimmten Überschriften gesucht. Set rSN = .Rows(1).Find(What:="A", LookIn:=xlValues, LookAt:=xlWhole) Set rSB = .Rows(1).Find(What:="B", LookIn:=xlValues, LookAt:=xlWhole) Set rSM = .Rows(1).Find(What:="C", LookIn:=xlValues,_ LookAt:=xlWhole) Set rSW = .Rows(1).Find(What:="Menge erfaßt gesamt", LookIn:=xlValues,_ LookAt:=xlWhole) .Range("A1:DA1").AutoFilter Field:=rSN.Column, Criteria1:="D" .Range("A1:DA1").AutoFilter Field:=rSB.Column, Criteria1:="E" .Range("A1:DA1").AutoFilter Field:=rSM.Column, Criteria1:="F" 'bis zum End With funktioniert alles einwandfrei. Nun brauche ich aber 'den SUBTOTAL Wert aus der Spalte "Menge erfaßt gesamt" und hier scheitere ich dblWertAndere = Application.WorksheetFunction.Subtotal(9, .Columns(rSW.Column)) ' _ rSW soll hier die Range der Spalte "Menge erfaßt gesamt" darstellen End With 'der Wert wird im folgenden auf einem zweiten Tabellenblatt abgespeichert Sheets("Auswertung").Range("D2").Value = dblWertAndere End Sub

Public Sub CommandButton1_Click() CommandButton1.Caption = "Wählen Sie die auszuwertende Datei aus." CommandButton2.Caption = "Auswertung" Application.ScreenUpdating = False Application.Dialogs.Item(xlDialogOpen).Show wbName = ActiveWorkbook ThisWorkbook.activate Application.ScreenUpdating = True End Sub

Hi Kaan
Unabhängig von Public...
ActiveWorkbook.Name = "Text-String"
Entweder...
Dim wbName As String
wbName = Activeworkbook.Name
With Workbooks(wbName).Worksheets()....
... oder ...
Dim WB As Workbook
Set WB = Activeworkbook
With WB.Worksheets()...
Die zweite Variante gefällt mir besser.
N.b.
ActiveWorkbook = Die momentan aktive Arbeitsmappe
ThisWorkbook = Die Mappe aus der das Makro abgespielt wird
(ThisWorkbook ist meist präziser)
Ein weiterer Hinweis. Anstelle der Verwendung einer Public-Variable, kannst du die Variable auch von Makro A nach B übergeben.

Sub MakroA()
Dim WB As Workbook
Set WB = ThisWorkbook
Call MakroB(WB)
End Sub

Sub MakroB(WB As Workbook)
MsgBox WB.Name
End Sub

cu
Chris

Sub CommandButton1_Click() Dim wbName As Workbook CommandButton1.Caption = "Wählen Sie die auszuwertende Datei aus." CommandButton2.Caption = "Auswertung" Application.ScreenUpdating = False Application.Dialogs.Item(xlDialogOpen).Show Set wbName = ActiveWorkbook ThisWorkbook.Activate Application.ScreenUpdating = True End Sub

Sub CommandButton2_Click() Dim ws As Worksheet Application.ScreenUpdating = False With wbName.Worksheets("Sheet1") 'hier kommt die Fehlermeldung .Open End With Set ws = ActiveWorkbook.Worksheets.Add ws.Name = "Auswertung" 'Tabellenerstellung Range("A1:D64").Select ActiveSheet.ListObjects.Add(xlSrcRange, Range("$A$1:$D$64"), , xlNo).Name = _ "Auswertung" Range("Auswertung[#All]").Select Call TblBeschriftung Call TblSpaltenErgebnis Call TblSpaltenAuswertungA Call TblSpaltenAuswertungB Application.ScreenUpdating = True End Sub

Beliebteste Forumthreads (12 Monate)

7
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

Excel VBA Subtotal

7 Beiträge zum Forumthread Beiträge zu diesem Forumthread

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

7
Beiträge zum Forumthread

Beiträge zu diesem Forumthread