Allen Dateien eines Verz. addieren mit SVerweis

Hallo in die Runde,
mit beigefügtem Code (gefunden von Herbert Taferner), werden alle Wert des Tabellenblattes 1 der Zelle B2 aus ALLEN Dateien, die sich im genannten Verzeichnis befinden summiertund mit dem bestehenden Werte hinzugerechnet und in Range("B2") eingetragen.
Das finde ich schon toll.
Nun benötige ich diesen (oder einen anderen) Code möglichst in Verbindung mit einer SVerweis-Prüfung.
Dabei soll folgende Struktur bei allen *Werte-Tabellen* gegeben sein:
A2:A100 = Produktbezeichnungen wie Butter, Zucker, Mehl...
B2:B100 = Mengenangaben
Das *Ergebnissheet* mit dem Makro soll dann in den Zellen A2:A11 auch wieder die Produktbezeichungen haben(aber halt nur ausgewählte, eben nur 10 Stück).
Nun soll das Makro die *Werte-Tabellen* durchsuchen und die Summierungsergebnisse je nach Eintrag der Produktbezeichnung im Spaltenbereich A2:A11 rechts danaben in B2:B11 eintragen.
(Dabei sei erst einmal dahingestellt, ob ich die bestehenden Werte hinzurechnen möchte oder dann später doch nicht).
Eine solche Lösung wäre perfekt, weil ich dann das *Ergebnissheet* je nach Summierungsbedarf für wenige ausgewählte Produkte frei gestalten könnte.
Geht das?
Vielen Dank für jede Hilfe!
Dietmar aus Aachen

Sub WerteausDateien_addieren()
' Werte einer Zelle aus allen Dateien
' eines Verzeichnisses addieren und ausgeben
Dim Dateiname As String
Dim Verz As String
Dim dat As String
Dim Blatt As String
Dim Zelle As String
Dim Gesamt As Variant
Dim Wert As Variant
Application.ScreenUpdating = False
Zelle = "B2" 'Hier Zelle angeben
Blatt = "Tabelle1" 'Hier Tabelle angeben
Verz = "C:\Daten\Test_01\" 'Hier Verzeichnis angeben
dat = "*.xls" 'Hier Datei angeben
If Right(Verz, 1)  "\" Then Verz = Verz & "\"
Dateiname = Dir$(Verz & dat)
Do While Dateiname  ""
Wert = ExecuteExcel4Macro("'" & Verz & "[" & _
Dateiname & "]" & Blatt & "'!" & _
Range(Zelle).Range("A1").Address(, , xlR1C1))
Gesamt = Gesamt + Wert
Dateiname = Dir$()
Loop
Application.ScreenUpdating = True
MsgBox "Summe " & Gesamt
Range("B2").Value = Gesamt
End Sub

Beitrag zum Forumthread

Beitrag zu diesem Forumthread

Betreff

Datum

Anwender

Sub WerteausDateien_addieren() ' Aus allen Dateien eines Verzeichnisses per Suche Werte finden und _ Werte aus Nachbarzelle addieren Dim Dateiname As String Dim Verz As String Dim dat As String Dim Zeile As Long, Zeile1 As Long, ZeileL As Long, Zelle As Range Dim wks As Worksheet, wkb As Workbook Application.ScreenUpdating = False Set wks = ActiveSheet Verz = "C:\Daten\Test_01\" 'Hier Verzeichnis angeben Verz = "D:\Test\Daten\" 'Hier Verzeichnis angeben dat = "*.xls" 'Hier Datei angeben Zeile1 = 2 ZeileL = 11 If Right(Verz, 1) "\" Then Verz = Verz & "\" Dateiname = Dir(Verz & dat) Do While Dateiname "" Set wkb = Application.Workbooks.Open(Filename:=Verz & Dateiname, ReadOnly:=True) With wkb.Worksheets(1) For Zeile = Zeile1 To ZeileL If wks.Cells(Zeile, 1).Value "" Then Set Zelle = .Range("A2:A100").Find(What:=wks.Cells(Zeile, 1).Value, _ LookIn:=xlValues, lookat:=xlWhole) If Not Zelle Is Nothing Then With wks.Cells(Zeile, 2) .Value = .Value + Zelle.Offset(0, 1).Value End With End If End If Next End With wkb.Close savechanges:=False Dateiname = Dir() Loop Application.ScreenUpdating = True End Sub

Beliebteste Forumthreads (12 Monate)

Allen Dateien eines Verz. addieren mit SVerweis

1
Beitrag zum Forumthread

Beitrag zu diesem Forumthread

302 Forumthreads zu ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

Allen Dateien eines Verz. addieren mit SVerweis

1 Beitrag zum Forumthread Beitrag zu diesem Forumthread

302 Forumthreads zu ähnlichen Themen

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

1
Beitrag zum Forumthread

Beitrag zu diesem Forumthread