Viele Datensätze schnell importieren
26.05.2009 15:23:23
Markus
ich habe ein kleines (eigentlich großes) Problem. Tino war so nett und hat mir ein funktionierenden Code zum importieren von Exceldaten geschrieben. Dieser ist hier https://www.herber.de/bbs/user/61337.xls einsehbar. Lediglich das Modul wurde von mir etwas angepasst (der Modul-Code kommt am Ende). Beim ursprünglichen Code bin ich vom importieren der Datensätze von A2:AK2 ausgegangen. Dies hat sich geändert und ist nun von A2:EA2. Dies habe ich soweit angepasst. Nur dauert der Import für ~60 Dateien rund 6 Minuten. Habe das ganze mal mit 3.000 Dateien getestet und nach 2 1/2 Stunden warten abgebrochen. Die Dateien sind alle gleich aufgebaut und befinden sich im gleichen Ordner. Importiert werden die Daten aus dem Tabellenblatt "Schlüsseldaten". Hat jemand eine Idee was ich evtl. falsch gemacht habe oder dauert es wirklich so lange? Gibt es Alternativen?
angepasster Modul-Code:
Option Explicit
Sub Start()
UserForm_Anzeige.Show
End Sub
Sub TestLeseDaten()
Dim sFiles As String
Dim strPfad As String, Listbox
Dim strFormel As String
Dim A As Long, AA As Long
Dim iCalc As Integer
'hier den Pfad angeben *****************************
strPfad = "H:\Aufträge\" & Application.InputBox("Bitte den Importmonat eingeben!", _
"Importieren", Format(Date - Day(Date), "MMMM")) & "\"
UserForm_Anzeige.Repaint
sFiles = Dir$(strPfad & "*.xls")
With Application
.ScreenUpdating = False
.EnableEvents = False
iCalc = .Calculation
.Calculation = xlCalculationManual
On Error GoTo ErrFehler:
AA = 2
Do While sFiles ""
For A = 1 To 131
strFormel = "'" & strPfad & "[" & sFiles & "]Schlüsselnummern'!R2C" & A
Cells(AA, A).Value = ExecuteExcel4Macro(strFormel)
Next A
AA = AA + 1
sFiles = Dir$()
Loop
ErrFehler:
.ScreenUpdating = True
.EnableEvents = True
.Calculation = iCalc
End With
Unload UserForm_Anzeige
If Err.Number 0 Then MsgBox Err.Number & Chr(13) & Chr(13) & Err.Description, vbCritical, " _
Fehler"
End Sub
Danke fürs schauen!
Gruß Markus