Supportnet / Forum / Tabellenkalkulation

Hallo zusammen, wie oben schon beschrieben möchte ich aus verschiedenen Arbeitsmappen Daten zusammentragen. Ich will die entsprechenden Zellen aber nicht direkt verknüpfen, sondern will Momentanwerte. Dazu verwende ich ein Makro womit ich diese Arbeitsmappen öffne, das entsprechende Tabellenblatt auswähle und die gewünschten Daten aus den Zellen in Variablen schreibe. Dann schließe ich die Arbeitsmappen wieder und trage die Variablen in die neue Arbeitsmappe ein. Das ist aber alles ziemlich umständlich finde ich. Mit Formeln kann ich ja auch Tabellen verknüpfen ohne diese zu öffnen. Kann ich das nicht auch mit Makros so abfragen? Hie ein Teil meines Quellcodes (mit der Funktion am Anfang frage ich nur ab ob die Tabelle evtl. geöffnet ist um keine Daten zu verlieren): [code]Function FileOpenYet(FileName As String) As Boolean ´eine Funktion, die Prüft ob eine Datei schon geöffnet ist. Dim s As String On Error GoTo Nonexistent s = Workbooks(FileName).Name FileOpenYet = True Exit Function Nonexistent: FileOpenYet = False End Function Sub Datenimport() Application.ScreenUpdating = False If FileOpenYet(Dir$("c:\Monatsbericht\Report.xls")) = False Then Workbooks.Open FileName:="c:\Monatsbericht\Report.xls" End If Workbooks(Dir$("c:\Monatsbericht\Report.xls")).Activate Sheets("Report").Activate VarTest = Range("A11").Value Workbooks(Dir$("c:\Monatsbericht\Auswertung.xls")).Activate Sheets("Gesamt").Activate Range("A1").Value = VarTest Workbooks(Dir$("c:\Monatsbericht\Report Data.xls")).Close SaveChanges:=True Application.ScreenUpdating = True End Sub[/code] Das funktionier zwar problemlos, wird jedoch bei mehreren Tausend Zellen in ca 5 verschiedenen Tabellen recht langsam. Ich habe da noch Schleifen drin wo ich bis zu ca 500 Zeilen nacheinander auslese bis die erste leere Zelle kommt, welche aber immer undefiniert ist. Gruß Locke

Bei der Gelegenheit noch was.
Kann man es irgendwie anstellen anstatt der Sanduhr während dem Import eine Messagebox oder etwas anderes zu zeigen das darauft hinweist das gerade etwas geschieht?

Gruß
Locke

Hallo Locke,

Du wirst wolhl weiterhin die Dateien öffnen müssen. Was ich allerdings nicht so ganz verstehe, warum Du die Daten erst in eine Variable speicherst und dann den Variablenwert in Deine Datei einließt. Warum öffnest Du nicht alle Dateien im Hintergrund und holst Dir dann die Daten direkt mit einem Copy-Befehl in Deine Datei.

Mal Deinen Code etwas eingekürzt:

Sub Datenimport()
Application.ScreenUpdating = False

If FileOpenYet(Dir$("c:\Monatsbericht\Report.xls")) = False Then
Workbooks.Open Filename:="c:\Monatsbericht\Report.xls"
End If

Workbooks("Report.xls").Sheets("Report").Range("A1").Value.Copy _
Workbooks("Auswertung.xls").Sheets("Gesamt").Range("A1").Value

Workbooks(Dir$("c:\Monatsbericht\Report Data.xls")).Close SaveChanges:=True

End Sub

Bei dem Code wird Ddie Datei Report.xls geöffnet falls noch nicht geschehen und der Wert aus Blatt "Report" Zelle A1 in die Datei "Auswertung" Blatt "Gesamt" übertragen. Bedingung hier wäre es dass die Datei Auswertung bereits geöffnet ist. Wenn das nicht sein soll, dann müsste man noch abfragen ob die Datei offen, wenn nicht öffnen. Ich habe den Code jetzt nicht getestet, aber so sollte es funktionieren. Wobei hier die Dateien nicht wie oben von mir erwähnt, im Hintergrund geöffnet werden.

Zu Deiner 2. Frage, da habe ich auf meiner HP in der Rubrik Beispieldateien und dort dann in dem Beispiel44 ein passendes Beispiel. Dort wird ein Fortschrittsbalken beim Abarbeiten eines Makros eingeblendet.

Ich hoffe, Dir helfen meine Antworten etwas weiter.

MfG,
Oliver
_{Da hier der einzige Lohn für die Helfer eine Rückmeldung ist, wäre es nett, wenn Du ein}
^{Feedback abgeben könntest, ob der Lösungsvorschlag Dein Problem gelöst hat.}

Danke Dir, ich werde das morgen mal einbauen und testen. Das würde das Ganze doch um einiges verkürzen. Mal sehen was die Bearbeitungszeit dazu meint, bin mal gespannt.
Im Moment rechnet mein PC so ca 30 Sekunden, muss mal die genauen Zeiten nehmen.

Das mit den Fortschrittsbalken muss ich mir dann auch erst mal noch genauer ansehen und damit "rumspielen".
Feedback dann hier.
Nochmals danke.

Gruß
Locke

Aaaaaalso:

Die Werte nicht mehr in Variablen zu speichern war eine gute Idee. Das einlesen der Daten dauerte zuvor 25 Sekunden, jetzt dauert es noch 5 Sekunden.
Ich habe aber trotzdem eine Lösung gefunden die Daten aus geschlossenen Arbeitsmappen auszulesen. Dazu benötigt man folgende Funktion:

Public Function GetValue(path$, file$, sheet$, range_ref$)
´Holt einen Wert aus einer _geschlossenen_ Arbeitsmappe
´Nur in VBA zu gebrauchen; nicht aus einer Tabellenzelle heraus
´© John Walkenbach / Übersetzt von Thomas Ramel

´Die GetValue-Funktion, benötigt die vier unten angeführten Arugmente:
´path:  Das Laufwerk und den Pfad der geschlossenen Datei (z.B. "C:\Daten")
´file:  Der Dateiname der Arbeitsmappe (z.B. "MeineDatei.xls")
´sheet: Der Name des TabellenblattesThe worksheet name (z.B. "Tabelle1")
´ref:   Der Zellbezug (z.B. "A1")
 Dim arg As String
´Sicherstellen, dass die Datei exisiert
 If Right(path, 1) <> "\" Then path = path & "\"
   If Dir(path & file) = "" Then
     GetValue = "Datei nicht gefunden"
     Exit Function
   End If
´Den Aufruf-String zusammenstellen
    arg = "´" & path & "[" & file & "]" & sheet & "´!" & _
      Range(range_ref).Range("A1").Address(, , xlR1C1)
´Ausführen des XL4-Makros
    GetValue = ExecuteExcel4Macro(arg)
End Function

Ein Anwendungsbeispiel:

Public Sub HoleWert()
    Dim rngZelle As Range
    Application.ScreenUpdating = False
    For Each rngZelle In ActiveSheet.Range("A1:B10")
       rngZelle = GetValue("c:\Verzeichnis\", "Arbeitsmappenname.xls", "Tabellenname", rngZelle.Address)
    Next rngZelle
    Application.ScreenUpdating = True
End Sub

^Quelle

Allerdings dauert das sehr lange, ist also nicht um viele Daten auzulesen, aber sehr interessant um mal eben ein Paar Werte zu "ziehen".

Nun werde ich mich mal an den Fortschrittsbalken machen.

Gruß
Locke

hi locke :)

kannst ja mal testen ob schneller ist vielleicht :))

wirst dich schon durchfummeln bzw anpassen denk ich :))

gruss nighty

Option Explicit
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
Cells(Dateien, 1) = ExecuteExcel4Macro("´C:\test3\" & "[" & DateiName & "]Tabelle1" & "´!" & Range("C1").Address(, , xlR1C1))
Next Dateien
End If
End With
End Sub

• Ausgewählte Daten in einer neuen Tabelle zusammenfassen
• Tabelle Anwenderfreundlich sortieren
• Alle Datensätze aus einer Access Tabelle via Makro löschen
• Mittels Makro Dokument speichern
• Zellen mittels Makro verketten