Live-Forum - Die aktuellen Beiträge
Anzeige
Archiv - Navigation
1084to1088
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

Tabelle zusammenlegen und abgleich

Tabelle zusammenlegen und abgleich
Karel
Gute Morgen,
Option Explicit

Sub listenauswertung()
' Variablen deklarieren
Dim vUebArrKd As Variant
Dim Blatt As Object
Dim lZielUeb As Long
Dim lZielUeb2 As Long
Dim iZiel As Integer                                                                    '  _
Letzte gefüllte Zelle
Dim az As Integer                                                                       ' Zä _
hler für Arrayfelder
Dim i As Integer                                                                        '  _
Schleifenzähler (Arrays füllen)
Dim arr() As Variant                                                                    ' Array  _
für Datenausgabe
Dim lZeile As Long
Dim vDatArr As Variant
Dim iSpalte As Integer
Dim sWs As String
Application.ScreenUpdating = False
vDatArr = Array("Januar", "Februar", "März", "April", "Mai", "Juni", "Juli", "August", " _
September", "Oktober", "November", "Dezember")
' Kunden übertragen
For Each Blatt In ActiveWorkbook.Sheets
If Right(Blatt.Name, 2) = "06" Then
lZielUeb = Sheets(Blatt.Name).Range("A65536").End(xlUp).Row
vUebArrKd = Sheets(Blatt.Name).Range("A2", "A" & lZielUeb).Value
lZielUeb2 = Sheets("Auswertung").Range("A65536").End(xlUp).Row + 1
Sheets("Auswertung").Range("A" & lZielUeb2, "A" & lZielUeb2 + lZielUeb - 2) = vUebArrKd
End If
Next Blatt
' Mehrfachnennungen von Kunden beseitigen
' Geschrieben von Klaus-Dieter Oppermann, Oktober 2005
' angepasst von Donkey August 2006
iZiel = Sheets("Auswertung").Range("A65536").End(xlUp).Row                              '  _
Letzte gefüllte Zelle ermitteln (in Spalte A)
' Array dimensionieren
ReDim arr(iZiel, 0)                                                                     ' Feld  _
nach Listenlänge festlegen
' Arrays mit Werten füllen
For i = 2 To UBound(arr)                                                                ' laufe  _
von Zeile 2 bis Tabellenende
If Application.WorksheetFunction.CountIf(Range(Sheets("Auswertung").Cells(i, 1), _
Sheets("Auswertung").Cells(1, 1)), Sheets("Auswertung").Cells(i, 1).Value) = 1 Then ' wenn  _
Wert das erste Mal vorkommt, dann ...
arr(az, 0) = Sheets("Auswertung").Cells(i, 1).Value                             ' ...  _
Name in Array einlesen
az = az + 1                                                                     ' ... Zä _
hler für Arrayfeld plus 1
End If                                                                              ' Ende  _
der Auswertung
Next i                                                                                  '  _
Schleifenzähler plus 1
' Inhalte ausgeben
Sheets("Auswertung").Range("A2", "A" & UBound(arr)) = arr                               ' Werte  _
in Ausgabebereich schreiben
' Summen ermitteln
For Each Blatt In ActiveWorkbook.Sheets
If Right(Blatt.Name, 2) = "06" Then
iSpalte = 2
sWs = Left(Blatt.Name, Len(Blatt.Name) - 4)
Do While sWs  Sheets("Auswertung").Cells(1, iSpalte)
iSpalte = iSpalte + 1
Loop
lZielUeb = Sheets(Blatt.Name).Range("A65536").End(xlUp).Row
For lZeile = 2 To az + 1
Sheets("Auswertung").Cells(lZeile, iSpalte) = Application.WorksheetFunction.SumIf( _
Range(Sheets(Blatt.Name).Cells(lZielUeb, 3), _
Sheets(Blatt.Name).Cells(2, 1)), Sheets("Auswertung").Cells(lZeile, 1), Sheets( _
Blatt.Name).Range("B2", "I" & lZielUeb))
Sheets("Auswertung").Cells(lZeile, 14) = Application.WorksheetFunction.Sum(Range("B" _
& lZeile, "M" & lZeile))
Next lZeile
End If
Next Blatt
With Sheets("Auswertung").Range("B2", "N" & az + 1)
.NumberFormat = "#,##0"
End With
Sheets("Auswertung").Columns("A:N").EntireColumn.AutoFit                                '  _
Spalten auf optimale Breite
Application.ScreenUpdating = False
End Sub


mit oben stehende Code von Klaus-Dieter Oppermann und Donkey werden aus alle Tabelleblätter Januar '06 bis Dezember '06 die werte von Spalte A und B in eine Liste Tabelleblatt Auswertung zusammengefügt.
soweit kein Problem, aber ich mochte gerne die anzahl Tabelleblätter erweiteteren über eine längere zeitraum 07, 08
ich scheitere am code
For Each Blatt In ActiveWorkbook.Sheets
If Right(Blatt.Name, 2) = "06" Then
wie kann mann dass lösen.
Summewert im Blat Auswertung ist nicht unbedingt nötig.
beispiel zugefügt
https://www.herber.de/bbs/user/62832.xls
Karel

3
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Benutzer
Anzeige
AW: Tabelle zusammenlegen und abgleich
30.06.2009 07:22:37
ede
Hallo Karel,
erweiter die if-Abfrage um die neuen Jahre:
If Right(Blatt.Name, 2) = "06" or If Right(Blatt.Name, 2) = "07" or If Right(Blatt.Name, 2) = "08"
gruss
AW: Tabelle zusammenlegen und abgleich
30.06.2009 07:24:04
ede
sorry, wer kopieren kann ist klar im vorteil, so natürlich
If Right(Blatt.Name, 2) = "06" or Right(Blatt.Name, 2) = "07" or Right(Blatt.Name, 2) = "08"
gruss
AW: Tabelle zusammenlegen und abgleich
30.06.2009 18:09:06
Karel
Hallo ede,
sorry kan jetzt soeben teste, deine ansatz funktioniert habe trotzdem noch eine frage.
jetzt muss ich Array immer länger schreiben "November", "Dezember", "jan07" etc. etc. kann mann auch die Tabellename direkt benutzen die dann natürlich gleich ist an Spalte überschrift
kann jetzt zB Januar nicht doppel schreiben.
vDatArr = Array("Januar", "Februar", "März", "April", "Mai", "Juni", "Juli", "August", "September", "Oktober", "November", "Dezember", "jan07")
' Kunden übertragen
For Each Blatt In ActiveWorkbook.Sheets
If Right(Blatt.Name, 2) = "06" Or Right(Blatt.Name, 2) = "07" Or Right(Blatt.Name, 2) = "08" Then
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige