viele Dateien summieren

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Sub test() Dim Summe As Double Dim i As Integer With Application.FileSearch .LookIn = "C:\DeinPfad" .FileType = msoFileTypeExcelWorkbooks .Execute For i = 1 To .FoundFiles.Count Workbooks.Open .FoundFiles(i), ReadOnly:=True Summe = Summe + ActiveWorkbook.Sheets(1).Range("a1").Value ActiveWorkbook.Close savechanges:=False Next End With MsgBox "Ergebnis: " & Summe End Sub

Sub prcXLSDateienÖffnenUndBerechnen() Dim fs As Object, objOrdner As Object Dim Datei As Object Dim wkb As Workbook Dim lngSumme As Long Dim strPfad As String Dim strZelle As String 'Pfad mit XLS-Dateien angeben strPfad = "I:\Ordner" 'Zelle zum summieren angeben strZelle = "B2" 'Alle XLS-Dateien des angegebenen Ordners werden geöffnet Set fs = CreateObject("Scripting.FilesystemObject") Set objOrdner = fs.getFolder(strPfad) For Each Datei In objOrdner.Files If Datei.Type = "Microsoft Excel-Arbeitsblatt" Then Set wkb = Workbooks.Open(strPfad & "\" & Datei.Name) lngSumme = lngSumme + wkb.ActiveSheet.Range(strZelle) wkb.Close End If Next Datei MsgBox lngSumme Set objOrdner = Nothing Set fs = Nothing End Sub

HI
was stört dich daran, die dateien zu öffen?
wenns das zucken am bildschirm ist, dann setze ein
application.screenupdating = false
an den Anfang des Makros und gut ist.
dadurch, daß ich die Dateien Schreibgschützt öffne, sollte es kein Problem geben, wenn gerade jemand anders mit diesen Datein arbeiten will.
ansonsten ist es schwierig, per makro auf geschlossene Excel-Dateien zuzugreifen.
da müssten dann die alten Excel4Makros ran (da kenne ich mich aber nicht aus)
oder du müsstest die Formel mit dem Fernbezug in die Zelle reinschreiben und diese Aufsummieren.
das wird dann aber wieder komplizierter,weil du erst für den Fernbezug die Eckigen Klammern in den Dateinamen reinbasteln musst.

Sub summieren() Dim n 'die Dateinamen sind in Spalte A des aktiven Blattes gelistet [g1] = 0 For n = 1 To Range("A65536").End(xlUp).Row 'letzte gefüllte Zelle in A [g1] = [g1] + Application.ExecuteExcel4Macro("'c:\test\[" & Cells(n, 1) & "]Tabelle1'!R11C9") Next n End Sub

Sub test() Dim Summe As Double Dim i As Integer Dim Pfad As String Dim Datei As String Pfad = "C:\Dokumente und Einstellungen\Slowboarder\Eigene Dateien\Excel" cells.clearcontents With Application.FileSearch .LookIn = Pfad .FileType = msoFileTypeExcelWorkbooks .Execute For i = 1 To .FoundFiles.Count Datei = Mid(.FoundFiles(i), Len(Pfad) + 2) Cells(i, 1).Value = .FoundFiles(i) Cells(i, 2).Formula = "='" & Pfad & "\[" & Datei & "]Tabelle1'!$A$1" Next End With with cells(65536,1).end(xlup).offset(2,0) .value = "Summe" .offset(0,1).formulalocal = "=Summe(B1:B" & .row-2 & ")" end with MsgBox "Ergebnis: " & WorksheetFunction.Sum(Range("B:B")) End Sub

Hallo Yasmine,
wenn die 1. Tabelle immer den gleichen Namen hat dan geht es mit einem der beiden Makros.
Falls die Namen der Tabelle unterschiedlich sind, dann fragt Excel in einem Auswahldialog nach dem Tabellennamen. Dann muss du halt 200 schnelle Klicks auf ok machen.
Gruß
Franz


Sub test1()
'Schreibt Formeln mit Verknüpfungen in Spalte A der aktiven Tabelle _
und bildet Summe
Dim Summe As Double, wks As Worksheet
Dim i As Integer, Tabelle As String, Zelle As String
Set wks = ActiveSheet
Pfad = "C:\Lokale Daten\Test"
Tabelle = "Tabelle1" 'Name der Tabelle aus der Zelle summiert werden soll
Zelle = "A1" 'Zelle die summiert werden soll
wks.Columns(1).Clear
With Application.FileSearch
.LookIn = Pfad
.FileType = msoFileTypeExcelWorkbooks
.Execute
For i = 1 To .FoundFiles.Count
wks.Cells(i, 1).Formula = "='" & Pfad & "\[" & Mid(.FoundFiles(i), _
Len(Pfad) + 2) & "]" & Tabelle & "'!" & Zelle
Next
wks.Cells(.FoundFiles.Count + 1, 1).Formula = "=sum(A1:A" & .FoundFiles.Count & ")"
MsgBox "Ergebnis: " & wks.Cells(.FoundFiles.Count + 1, 1).Value
End With
End Sub
Sub test2()
'Schreibt formeln mit verknüpfung in Zelle A1 und Summe jeweils  in B1
Dim Summe As Double, wks As Worksheet
Dim i As Integer, Tabelle As String, Zelle As String
On Error Resume Next 'überspringt Zellen mit text
Set wks = ActiveSheet
Pfad = "C:\Lokale Daten\Test"
Tabelle = "Tabelle1" 'Name der Tabelle aus der Zelle summiert werden soll
Zelle = "A1" 'Zelle die summiert werden soll
wks.Cells(1, 1).Clear
With Application.FileSearch
.LookIn = Pfad
.FileType = msoFileTypeExcelWorkbooks
.Execute
For i = 1 To .FoundFiles.Count
wks.Cells(1, 1).Formula = "='" & Pfad & "\[" & Mid(.FoundFiles(i), _
Len(Pfad) + 2) & "]" & Tabelle & "'!" & Zelle
wks.Cells(1, 1).Value = wks.Cells(1.1).Value
Summe = Summe + wks.Cells(1, 1).Value
wks.Cells(1, 2).Value = Summe
Next
MsgBox "Ergebnis: " & Summe
End With
End Sub

Sub prcXLSDateienBerechnenOhneÖffnen() Dim fs As Object, objOrdner As Object, Datei As Object Dim lngSumme As Long, strPfad As String, strZelle As String, strFormula As String strPfad = "I:\Ordner" 'Pfad mit XLS-Dateien angeben strZelle = "B2" 'Zelle zum summieren angeben Set fs = CreateObject("Scripting.FilesystemObject") Set objOrdner = fs.getFolder(strPfad) For Each Datei In objOrdner.Files If Datei.Type = "Microsoft Excel-Arbeitsblatt" Then strFormula = "='" & strPfad & "\[" & Datei.Name & "]" & "Tabelle1'!" & strZelle ThisWorkbook.ActiveSheet.Range("b2").Formula = strFormula 'gefundenden Wert _ ausgeben lngSumme = lngSumme + ThisWorkbook.ActiveSheet.Range("B2").Value ThisWorkbook.ActiveSheet.Range("b2") = lngSumme 'Summe ausgeben End If Next Datei Set objOrdner = Nothing Set fs = Nothing End Sub

Beliebteste Forumthreads (12 Monate)

14 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

14
Beiträge zum Forumthread

Beiträge zu diesem Forumthread