Anzeige
Archiv - Navigation
928to932
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
928to932
928to932
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Inhaltsverzeichnis

Performancebremsen

Performancebremsen
27.11.2007 15:09:42
Fabian
Hallo Leidensgenossen ;)
heute ausnahmsweise funktionierender (fragt mich nicht wieso) VBA-Code der aber leider eine sehr lange Durchlaufzeit hat. Der Code steht in nem Modul und wird in einer Arbeitsmappe aufgerufen in der ungefähr 200 Teile mit allen möglichen Spalten stehen (Teilenummer, Teilebenennung, Verantwortlicher, HTKT-Kategorie, Material, usw) falls sich nun etwas an diesen Teilen ändert wird in Spalte 63 ein "Ä" gesetzt (mit einem anderen, wesentlichen schnelleren Macro...). Anhand dieses "Ä"s erstellt oder öffnet das untere Macro also erstmal den passenden Lebenslauf und den passenden Reiter (der sich aus Spalte 2 und 3 zusammensetzt). Im passenden Reiter wird nun in Zeile 3 erstmal eine Verknüpfung zur Arbeitsliste erstellt, alte Zeilen nach unten verschoben und in Zeile 4 eine Kopie von Zeile 3 mit "festen" Werten angelegt. Also so eine Art Teile-History...
Das einzige Problem ist jetzt das Excel bei 100 Teilen mit "Ä" geschlagene 4 Minuten in Winterschlaf fällt. Ok, das ist wegen ScreenUpdating = False zwar durchaus Absicht, aber 4 Minuten sind doch etwas heftig.

Global SpErste As Integer, SpLetzte As Integer, SpAenderung As Integer



Sub Init_Globals()
SpErste = 1 '1. Spalte die kopiert werden soll -
SpLetzte = 62 'letzte Spalte die kopiert werden soll - der Timestamp
SpAenderung = 63 'Spalte für ÄnderungsMarkierung
End Sub



Sub LebenslaufAktualisieren()
Dim lZeile&, lZeileLL&
Dim wbLebenslauf As Workbook, wbThis As Workbook
Dim wksHaupt As Worksheet, wksTeileNr As Worksheet
Dim sTeileNr$, sHTKT$, sPfadLebenslauf$, sDateiLebenslauf$, sVorlage$
sPfadLebenslauf = ThisWorkbook.Path
sVorlage = ThisWorkbook.Path & "\VorlageLebenslauf.xlt"
Set wbThis = ThisWorkbook
Set wksHaupt = wbThis.Worksheets("Gesamt")
Application.ScreenUpdating = False
For lZeile = 4 To wksHaupt.Cells(wksHaupt.Rows.Count, SpAenderung).End(xlUp).Row
'Prüfen, ob Zeile als "geändert" markiert
If wksHaupt.Cells(lZeile, SpAenderung).Value = "Ä" Then
'Teile-Nr für Blattnamen zusammensetzen
sTeileNr = wksHaupt.Cells(lZeile, 2).Value & " " & wksHaupt.Cells(lZeile, 3)
If sHTKT  wksHaupt.Cells(lZeile, 12).Value Then   ' HT oder KT  als Lebenslaufname
sHTKT = wksHaupt.Cells(lZeile, 12).Value  ' HT oder KT  als Lebenslaufname
sDateiLebenslauf = "Lebenslauf " & sHTKT & ".xls"
'Prüfen, ob Lebenslauf-Datei im Verzeichnis existiert
If Dir(sPfadLebenslauf & "\" & sDateiLebenslauf) = "" Then
If MsgBox("Datei " & sPfadLebenslauf & "\" & sDateiLebenslauf & " existiert nicht!" _
& vbLf & "Datei neu anlegen?", vbOKCancel, "Lebenslauf aktualiseren") = vbCancel Then
Exit For
Else
'Lebenslaufdatei für neuen Verantwortlichen anlegen
Set wbLebenslauf = Workbooks.Add(Template:=sVorlage)
Set wksTeileNr = wbLebenslauf.Worksheets(1)
wksTeileNr.Name = sTeileNr
wbLebenslauf.SaveAs FileName:=sPfadLebenslauf & "\" & sDateiLebenslauf
End If
Else
'Überprüfung ob Lebenslauf schon geöffnet um gegebenfalls Fehlermeldung zu vermeiden - _
_
funktioniert komischerweise so auch
If IsOpen(sDateiLebenslauf) Then
Set wbLebenslauf = Workbooks.Open(FileName:=sPfadLebenslauf & "\" &  _
sDateiLebenslauf)
Else
Set wbLebenslauf = Workbooks.Open(FileName:=sPfadLebenslauf & "\" &  _
sDateiLebenslauf)
End If
End If
End If
'Prüfen, ob Blatt mit Teilenr. vorhanden
For Each wksTeileNr In wbLebenslauf.Worksheets
If wksTeileNr.Name = sTeileNr Then Exit For
Next
If wksTeileNr Is Nothing Then
'Blatt für nicht vorhandene Nummer anlegen
Set wksTeileNr = wbLebenslauf.Sheets.Add(After:=wbLebenslauf.Sheets(wbLebenslauf.Sheets. _
_
Count), _
Type:=sVorlage)
wksTeileNr.Name = sTeileNr
End If
With wksTeileNr
lZeileLL = 3
'Teilezeile in Arbeitsliste auswählen
wksHaupt.Range(wksHaupt.Cells(lZeile, SpErste), wksHaupt.Cells(lZeile, SpLetzte)). _
Copy
'Lebenslauf aufrufen
.Select
'Erste Zeile markieren
.Range("A" & lZeileLL).Select
'Verknüpfung zur Arbeitsmappe erstellen
ActiveSheet.Paste Link:=True
'zweite zeile markieren
.Range("A" & lZeileLL + 1 & ":BJ" & lZeileLL + 1).Select
'nachfolgende zeilen nach unten verschieben und markierung einfügen
Selection.Insert shift:=xlShiftDown
'erste Zeile markieren
.Range("A" & lZeileLL & ":BJ" & lZeileLL).Select
'markierung kopieren
Selection.Copy
'Verknüpfung durch feste Werte ersetzen
ActiveSheet.Range("A" & lZeileLL + 1 & ":BJ" & lZeileLL + 1).PasteSpecial Paste:= _
xlPasteValues
End With
'Änderungsmarkierung löschen
wksHaupt.Cells(lZeile, SpAenderung).ClearContents
End If
Next
If Not wbLebenslauf Is Nothing Then wbLebenslauf.Save
wbThis.Save
Set wbLebenslauf = Nothing: Set wbThis = Nothing: Set wksHaupt = Nothing
Set wksTeileNr = Nothing
Application.CutCopyMode = False
Application.ScreenUpdating = True
End Sub



Function IsOpen(FileName As String) As Boolean
'Überprüfung ob Lebenslauf schon geöffnet ist
Dim wb As Workbook
For Each wb In Application.Workbooks
If UCase(wb.Name) = UCase(FileName) Then
Workbooks(FileName).Save
IsOpen = True
Exit Function
End If
Next wb
IsOpen = False
End Function


Vorschläge und Anregungen sind herzlichst willkommen ^^
MfG Fabian

3
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Performancebremsen
27.11.2007 15:53:00
Richard
Ich behelfe mir bei Performanceproblemen zusätzlich mit einer Umstellung der Berechung auf "händisch"
Application.Calculation = xlCalculationManual
und schalte nach getaner Arbeit wieder auf Automatic um
Application.Calculation = xlCalculationAutomatic
Vielleicht hilft's auch bei Dir,
Gruß aus Graz

AW: Performancebremsen
27.11.2007 19:40:00
Hajo_Zi
Hallo Richard,
warum muss immer am Ende des Codes die Berechnung auf automatisch gestellt werden. Besser ist es den Modus zu Beginn auslesen, dann manuell und am Ende wieder auf den ausgelesen Wert. Es soll Leute geben, die es grundsätzlich auf manuell haben!

Anzeige
AW: Performancebremsen
27.11.2007 15:55:40
Andi
Hi,
zusätzlich zu Richards Tip könnest Du noch die Bildschirm-Aktualisierung ausschalten, und vor allem sämtlliche Selects aus Deinen Code verbannen.
Schönen Gruß,
Andi

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige