Office: Aus viele Dateien eine bestimmte Zelle addieren

cybrid · 1. November 2005

Hallo,

ich habe einen Ordner in dem ich Excel Dateien erstellt habe.
Der Ordner heißt "2005".
In diesen Ordner liegen Excel Dateien die alle unterschiedlieche Benennungen haben.
Aber alle Dateien haben an derselben stelle in der Tabelle1 ein Feld (C50) mit einem Ergebnis.

Jetzt möchte ich gerne in einer separaten Datei die Summe aller C50 Zellen aus den Dateien in dem Ordner 2005 haben.

Wie kann man also mit VBA oder wie auch immer, eine Datei nach der anderen auslesen und jeweils die Zelle C50 hinzuaddieren?

Bin für jeden Hinweis dankbar.

bYe
cybrid

:)

Silvestro · 2. November 2005

Ciao Cybrid,

dies kannst du mit Verknüpfungen erledigen. Gib in der Zelle wo du das Ergebnis haben möchtest folgendes ein:

Code:

=SUMME([Mappe1.xls]Tabelle1!C50;[Mapp2.xls]Tabelle1!C50)
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

und dann soweiter, bis du sie alle hast! Dies mußt du dann mit deinen Namen anpassen!

Ciao Silvestro

P.S. Wenn die Quellarbeitsmappe nicht geöffnet ist, enthält die Verknüpfung den gesamten Pfad. Es würde dann ungefähr so aussehen:

=SUMME('C:\2005\[Mappe1.xls]Tabelle1!C50;[Mapp2.xls]Tabelle1!C50)

cybrid · 2. November 2005

Danke.
Aber soviel tippen wollte ich eigentlich nicht.
Ich habe mehrere solcher Verzeichnisse aus den letzten Jahren mit jeweils 50 bis 70 Dateien.

Das wird dann eine ewig lange Verknüpfung.

Knee · 3. November 2005

Hallo cybrid,

kopiere den folgende Code in ein allgemeines Modul.

Code:

Sub dateiensuchen_und_summieren()
Dim fs As Variant, i As Integer, summe As Double
Set fs = Application.FileSearch
With fs
.LookIn = "DeinPfad" & "\2005" 'hier musst du deinen Pfad angeben
.SearchSubFolders = True 'Unterordner auch durchsuchen
.Filename = "*.xls" 'alle Excel-Dateien
.Execute
For i = 1 To .FoundFiles.Count
Workbooks.Open .FoundFiles(i)
summe = summe + ActiveWorkbook.Sheets(1).Range("C50").Value
ActiveWorkbook.Close savechanges:=False
Next i
End With
Range("A1").Value = summe 'Eintragen der ermittelten Summe
Set fs = Nothing
End Sub
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

Der Code öffnet jede Datei die er im von dir definierten Pfad (sowie Unterordner) findet.

Die Summe wird dann in deine Datei aus der du das Makro gestartet hast in die Zelle A1 des aktiven Arbeitsblattes kopiert

Ich hoffe das hilft dir weiter...

cybrid · 10. November 2005

Genau so!
Genial. Funktioniert super.

Danke.

juergenkemeter · 8. Januar 2006

Hallo,
bezuegl. Knee's Code - funktioniert prima, jedoch kommt fuer jedes Workbook eine Meldung - wie kann ich die Meldung "update links", die bei meinen Workbooks immer beim oeffnen kommt, unterdruecken bzw. auf true setzen?

Viele Gruesse
Juergen

MichaelMichael · 8. Januar 2006

Hallo,

versuchs mal mit

Workbooks.Open Filename:=.FoundFiles(i), UpdateLinks:=False

MfG Michael

juergenkemeter · 9. Januar 2006

Hi Michael,
funktioniert prima, danke!

Juergen

juergenkemeter · 9. Januar 2006

Hi.
jetzt hab ich den Beispielcode fuer meine Zwecke umgeaendert, leider funzt es noch nicht so ganz wie ich will.

Der Code hier oeffnet jede xls Datei im angegebenen Ordner, schaut im Range nach Daten, und schreibt diesen Inhalt in ein Worksheet.
Leider wird beim Oeffnen vom naechsten Workbook der gleiche Bereich des neuen Worksheets mit dem neuen Range ueberschrieben, so dass am Schluss nur die Daten des zuletzt geoeffneten Workbooks zu sehen sind.

Code:

Sub Test_dateiensuchen_und_daten_extrahieren()

Dim fs As Variant, i As Integer, bla As Variant
Dim cl As Range
Set fs = Application.FileSearch

With fs
.LookIn = "M:\Development\GeneSheets_DataExtract_Loop\Gene.File.Lists"
.SearchSubFolders = True 'Unterordner auch durchsuchen
.Filename = "*.xls" 'alle Excel-Dateien
.Execute

For i = 1 To .FoundFiles.Count
Workbooks.Open .FoundFiles(i), UpdateLinks:=False 'disable message boxes
bla = ActiveWorkbook.Worksheets("Sequence Data").Range("B6:M9").Formula
ActiveWorkbook.Close savechanges:=False
Range("B2:M5").Formula = bla
Next i

End With

Set fs = Nothing
End Sub
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

hab schon statt Formula Value ausprobiert, macht keinen Unterschied.
Folgender Code funktioniert auch nicht so ganz, aber evtl. ein Ansatz:
Code:

bla = ActiveWorkbook.Worksheets("Sequence Data").Range("B6:M9").Value
ActiveWorkbook.Close savechanges:=False
Set cl =Range(""b65536").End(xlUp) ' next empty cell
cl.Select
ActiveSheet.Paste
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

juergenkemeter · 9. Januar 2006

Hi,
ich habs mit folgendem Code geschafft:
Code:

Sub Test_dateiensuchen_und_daten_extrahieren()

Dim fs As Variant, i As Integer, bla
Dim strRange As String, colcount As Integer, colcount2 As Integer
Set fs = Application.FileSearch

colcount = 2
colcount2 = 5

strRange = "B" & colcount & ":M5"

With fs
.LookIn = "M:\Development\GeneSheets_DataExtract_Loop\Gene.File.Lists"
.SearchSubFolders = True 'Unterordner auch durchsuchen
.Filename = "*.xls" 'alle Excel-Dateien
.Execute

For i = 1 To .FoundFiles.count - 1

Workbooks.Open .FoundFiles(i), UpdateLinks:=False 'disable message boxes
bla = ActiveWorkbook.Worksheets("Sequence Data").Range("B6:M9")
ActiveWorkbook.Close savechanges:=False

Range(strRange) = bla
colcount = colcount + 4
colcount2 = colcount2 + 4
strRange = "B" & colcount & ":M" & colcount2
'Range("B2:M5").Formula = bla
Next i

End With

Set fs = Nothing
End Sub
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

Juergen

User · 10. Januar 2006

hi ihr *biggrinlove

hier noch eine variante ohne dateien öffnen zu müssen *dance

gruss poltergeist *yelrotflmao

Code:

Sub makro01()
Dim Dateien As Integer
Dim Zeichen As Integer
Dim DateiName As String
With Application.FileSearch
.NewSearch
.LookIn = "C:\test3"
.SearchSubFolders = False
.Filename = "*.*"
If .Execute() > 0 Then
For Dateien = 1 To .FoundFiles.Count
For Zeichen = Len(.FoundFiles(Dateien)) - 4 To 1 Step -1
If Mid(.FoundFiles(Dateien), Zeichen, 1) = "\" Then
DateiName = Mid(.FoundFiles(Dateien), Zeichen + 1, Len(.FoundFiles(Dateien)) - 4)
Exit For
End If
Next Zeichen

rem c1 wird ausgelesen und in a1 addiert

Cells(1, 1) = Cells(1, 1) + ExecuteExcel4Macro("'C:\test3\" & "[" & DateiName & "]" & Sheets(1).Name & "'!" & Range("C1").Address(, , xlR1C1))
Next Dateien
End If
End With
End Sub
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

Office: Aus viele Dateien eine bestimmte Zelle addieren

Aus viele Dateien eine bestimmte Zelle addieren

Aus viele Dateien eine bestimmte Zelle addieren

Aus viele Dateien eine bestimmte Zelle addieren

Aus viele Dateien eine bestimmte Zelle addieren

Aus viele Dateien eine bestimmte Zelle addieren - Similar Threads - Dateien bestimmte Zelle

Bestimmte Zellen aus geschlossenen Dateien in eine Master Liste hineinkopieren VBA

VBA: Bestimmte Zellen von einer Excel Datei in die andere (nach Bedienungen)

Excel VBA Datei durchsuchen, Datentyp prüfen und bestimmten Inhalt auslesen

Datei schließen nach bestimmter Zeit.

Öffnen einer bestimmten Seite einer pdf-Datei

Datei automatisch per mail senden (täglich zu einer bestimmten Uhrzeit)

VBA Bestimmte Zellen aus einer anderen Datei in eine andere Datei kopieren