Bestimmte Bereiche aus mehreren Excel Datein
25.09.2018 13:22:40
Chris
Ich habe Problem mit einer per VBA erstellten Excel Datei, nachdem ich die kompletten Daten eingelesen habe, ist die Datei nicht zu gebrauchen, da schon nur Filtern eine Wartezeit von mehreren Mintuen hervorruft. Die Datei hat dann im Druchschnitt 50000 Zeilen
Allersdings muss ich noch einige Abgleiche mit einer weiteren eingelesen Datei per Formel ermitteln.
Wobei die Automatische Berechnung bereits deaktiviert ist.
Nun habe ich alle mir eingefallen Varianten probiert und bin zu dem Entschluss gekommen ich muss selektieren, da ich eigentlich nur Teilbereiche (z.B.: A3:C169 und A194:C195 .... A1885:C1886) benötige, da andere Daten andere Serviceleistungen darstellen, welche ich nicht auswerte für meinen Vergleich. In Summe entstehen so pro eingelesene Datei nur c.a. 300 Zeilen, anstelle der momentanen 1960. Dies sollte die spätere Arbeitsmappe dann besser bedienbar machen, da ich die Daten dann übergebe.
Ich würde somit gern bei diesem Makro den Auswahlbereich der Quelle auf unterschiedliche Bereiche begrenzen wollen. (z.B.: A3:C169 und A194:C195 .... A1885:C1886)
Allerdings komme ich mit den z s Koordinaten, oder Bezügen nicht klar, da es sich hier nicht um Z1S1 Bezüge handelt.
Kann mir hier vielleicht jemand helfen? Danke
Hier mal das funktionierende Makro, was die kompletten ersten drei Spalten einliest und angepasst werden müsste:
Sub MWTabellenAusMehrerenDateienEinlesen()
Dim oTargetSheet As Object
Dim oSourceBook As Object
Dim sPfad As String
Dim sDatei As String
Dim lErgebnisZeile As Long
Dim s As Long
Dim z As Long
Application.ScreenUpdating = False 'Das "Flackern" ausstellen
'Schritt 1: Neues Arbeitsblatt für die Ergebnisse erstellen
Set oTargetSheet = ActiveWorkbook.Sheets.Add
lErgebnisZeile = 1 'Ergebnisse eintragen ab Zeile 1
'Schritt 2: Schleife über alle Excel Dateien in einem Verzeichnis
sPfad = "E:\SSTI Import\"
sDatei = Dir(CStr(sPfad & "*.xl*")) 'Alle Excel Dateien
Do While sDatei ""
'Schritt 3: öffnen der Datei und Datenübertragung
Set oSourceBook = Workbooks.Open(sPfad & sDatei, False, True) 'nur lesend öffnen
'Datenübertragung alle genutzten Zeilen und Spalten
For z = 1 To oSourceBook.Sheets("Site Material").UsedRange.Rows.Count
'Keine Leerzeilen verarbeiten
If Trim(CStr(oSourceBook.Sheets("Site Material").Cells(z, 2).Value)) "" Then
For s = 1 To 3
'Spalte 1 - Dateinamen T
oTargetSheet.Cells(lErgebnisZeile, 1).Value = sDatei
'Spalte 2 bis 4 - Tabelleninhalte des Arbeitsblattes "Site Material"
oTargetSheet.Cells(lErgebnisZeile, s + 1).Value = _
oSourceBook.Sheets("Site Material").Cells(z, s).Value
Next s
lErgebnisZeile = lErgebnisZeile + 1
End If
Next z
'Schritt 4: Datei wieder zu machen und nächste Schleifenrunde
oSourceBook.Close False 'nicht speichern
'Nächste Datei
sDatei = Dir()
Loop
Application.ScreenUpdating = True 'Das Bildschirm-Aktualisieren wieder einschalten
'Variablen aufräumen
Set oTargetSheet = Nothing
Set oSourceBook = Nothing
End Sub
Vielen Dank!
Gruß, Chris