Re: Excel nach Makro sehr langsam
04.12.2002 16:42:27
Uwe
Hallo Hajo,am einfachsten ist wohl in poste mal einen Teil des Makros. Dann wirds wohl einfacher.
Sub Laufzeiten() '
' Makro zur automatischen Aktualisierung der Prüfstandsbelegung
' Makro erstellt am 03.12.2002
'
Dim Pfad1, Pfad, Datei1, Verzeichnis As String 'Variablendeklaration
Dim Datum, Zeit As Date
Dim Bstd_PL, Bstd_Mot As Double
Dim Länge As Long
Dim i As Integer
Application.ScreenUpdating = False 'Auffrischung des Bildschirms verhindern
Application.Calculation = xlManual
'==============================================================================
'Bezugsdaten
Worksheets("Laufzeiten").Activate 'Tabelle Pfade aktivieren
Range("J1").Select 'Zelle J1 markieren
ActiveCell.Value = Date 'Datum eintragen
Range("N1").Select 'Zelle N1 markieren
ActiveCell.Value = Time 'Uhrzeit eintragen
'==============================================================================
'Prüfstand 1
ChDir "\\Pst_1\C\MGG_Prog\config" 'Verzeichniswechsel
Workbooks.OpenText Filename:="\\Pst_1\C\MGG_Prog\config\Pst_01.ini", Origin:= _
xlWindows, StartRow:=1, DataType:=xlFixedWidth, FieldInfo:=Array(Array(0, _
1), Array(50, 1), Array(52, 1), Array(55, 1), Array(58, 1))
ActiveWindow.SmallScroll Down:=201 'PST_01.ini öffnen
Cells.Find(What:="group3=1, 201, 300, C:\MGG_Prog\daten", After:=ActiveCell _
, LookIn:=xlFormulas, LookAt:=xlPart, SearchOrder:=xlByRows, _
SearchDirection:=xlNext, MatchCase:=False).Activate
Cells.FindNext(After:=ActiveCell).Activate 'Nach Pfadangabe suchen
ActiveCell.Select 'Pfad erxtrahieren
Pfad1 = ActiveCell.Value
Länge = Len(Pfad1)
Verzeichnis = Mid(Pfad1, 39)
Länge = Len(Verzeichnis)
Verzeichnis = Left(Verzeichnis, Länge - 3)
ActiveWorkbook.Close savechanges:=False 'Datei schliessen
Pfad = "\\Pst_1\C\MGG_Prog\Daten\" & Verzeichnis & "\Laufzeiten"
'Vollständiger Pfad in Variable
ChDir Pfad 'Pfadwechsel
Worksheets("Pfade").Activate 'Tabelle Pfade aktivieren
Range("A1:A50").Select 'Spalte A markieren
Selection.ClearContents 'Alten Inhalt löschen
Range("A1").Select 'Zelle A1 markieren
Datei1 = Dir$(Pfad & "\*.*") 'Dateien in Verzeichnis auflisten
Do While Datei1 <> ""
ActiveCell.Offset(i, 0) = Datei1
i = i + 1
Datei1 = Dir$()
Loop
Range("A1").Select 'Sortieren nach Name
Selection.CurrentRegion.Select
Selection.Sort Key1:=Range("A1"), Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
[A1].Select 'Zelle A1 markieren
ActiveCell.End(xlDown).Select 'Letzte Zelle suchen (neuste Datei)
Datei1 = Pfad & "\" & ActiveCell.Value 'ZU öffnende Datei (Pfad und Name) in Datei1
Workbooks.Open (Datei1) 'Datei öffnen
[A4].Select 'Zelle A4 markieren
ActiveCell.End(xlDown).Select 'Letzte Zelle markieren (Datum)
Datum = Format(ActiveCell.Value, "mm.dd.yy") 'Datum formatieren / Wert in Variable
[B4].Select 'Zelle B4 markieren
ActiveCell.End(xlDown).Select 'Letzte Zelle markieren (Uhrzeit)
Zeit = ActiveCell.Value 'Wert in Variable (Uhrzeit)
[F4].Select 'Zelle F4 markieren
ActiveCell.End(xlDown).Select 'Letzte Zelle markieren (Stunden Prüflauf)
Bstd_PL = ActiveCell.Value 'Wert in Variable (Stunden Prüflauf)
[G4].Select 'Zelle G4 markieren
ActiveCell.End(xlDown).Select 'Letzte Zelle markieren (Stunden Motor)
Bstd_Mot = ActiveCell.Value 'Wert in Variable (Stunden Motor)
ActiveWorkbook.Close savechanges:=False 'Datei schliessen
Worksheets("Laufzeiten").Activate 'Tabelle Pfade aktivieren
Range("K11").Select 'Zelle K11 markieren
ActiveCell = Bstd_PL 'Variable in Zelle schreiben (Std. Prüflauf)
Range("L11").Select 'Zelle L11 markieren
ActiveCell = Bstd_Mot 'Variable in Zelle schreiben (Std. Motor)
Range("AA11").Select 'Zelle AA11 markieren
ActiveCell = Datum 'Variable in Zelle schreiben (Bezugsdatum)
Range("AC11").Select 'Zelle AC11 markieren
ActiveCell = Zeit 'Variable in Zelle schreiben (Bezugszeit)
'================================================================================================
Der Rest des Makros ist praktisch gleich mit anderen Pfadangaben und anderen Dateinamen.
Gruß Uwe