Live-Forum - Die aktuellen Beiträge
Datum
Titel
28.03.2024 21:12:36
28.03.2024 18:31:49
Anzeige
Archiv - Navigation
1612to1616
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
Inhaltsverzeichnis

Performance letzter Schritt

Performance letzter Schritt
06.03.2018 09:40:02
Burak
Guten Morgen,
also erstmal bissel außen rum erzählen:
Mein Makro funktioniert grundsätzlich im Gesamten schon sehr gut, sodass mein Chef meinte das soll ich demnächst den PTLs und Abteilungsleitern präsentieren.
Dafür muss ein gewisser Prozess des Makros aber noch DEFINITIV schneller funktionieren. Wenn die Hälfte der Präsentation daraus besteht, dass wir den Wartebalken anstarren, ist dsa eher suboptimal.
Kommen wir zum Makro...
Dieser Teil des Makros besteht aus 5 Teilen:
Rüstwechsel /Barcodewechsel suchen und zählen
Rüstwechselzeiten ermitteln
Produktionsmengen ermitteln
Störungen ermitteln
Ausgeben
Anhand von Fortschrittsbalken habe ich erkannt, dass die ersten beiden Teile viel zu lange brauchen.
Im Beispiel geht es natürlich viel schneller, da nur wenige Datensätze vorliegen, aber im Original mehrere Tausend.
Wie kriege ich die Zählschleifen schneller hin.
Denke mal die Kommentare im Code helfen dabei, den Code schnell zu verstehen.
Beispieldatei: (WICHTIG DABEI: ALS START UND ENDDATUM DEN 05.03.2018 EINGEBEN!)
https://www.herber.de/bbs/user/120226.zip

Vielen vielen Dank im voraus! Ihr seid die Besten!
Liebe Grüße
Burak

10
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Performance letzter Schritt
06.03.2018 09:43:41
Hajo_Zi
die Datei kann nicht heruntergeladen werden, was wohl daran liegt das Du es als Code gekennzeichnet hast. Warum Zip?
Select, Activate usw. ist in VBA zu 99,8% nicht notwendig.
Der Cursor ist kein Hund der überall rumgeführt werden muss.
Hinweise zu select usw. Hajo-Excel.de
Hinweise zu select usw. Online-Excel.de
Hinweise zu select usw. Online-Excel.de
Der Cursor ist kein Hund, der überall rum geführt werden muss.

Beiträge von Werner, Luc, robert, J.O.Maximo und folgende lese ich nicht.
Anzeige
AW: Performance letzter Schritt
06.03.2018 16:41:26
japes36
Hi,
ich persönlich find zwar Statusbalken auch optisch ganz nett, aber bei aufwändigeren Berechnungen ersetz ich sie mittlerweile durch ein einfaches "Bitte warten..." PopUp. Das berechnen des Statusbalkens mit anschließendem DoEvents bremst den Code deutlich aus.
Lass einfach mal deinen kompletten Datensatz laufen mit und ohne aktivem Statusbalken und stoppe die Zeiten.
Viele Grüße
AW: Performance letzter Schritt
08.03.2018 06:29:42
Burak
Ja das Gefühl hatte ich auch schon. Dann switche ich lieber zu einem einfachen "Bitte warten"-Fenster. Danke dir!
AW: Performance letzter Schritt
08.03.2018 06:29:02
Burak
Erst einmal Sorry! Da ich gestern unerwartet frei hatte, schreibe ich erst jetzt!
hmmm... merkwürdig. wenn ich den link kopiere und in die adresszeile einfüge, funktioniert es bei mir.
Obwohl 8 der 10 Tabellenblätter unter 15 Zeilen haben und die anderen beiden nicht über 200 Zeilen, ist die Datei über 400KB groß gewesen, und da ich kein pack-programm aufm pc raufbekomme, habe ich es online gepackt.
Anders kann ich es mir nicht erklären, warum es bei dir nicht geht.
Danke trotzdem.
Anzeige
AW: Performance letzter Schritt
06.03.2018 19:10:16
Rudi
Hallo,
das kommt durch deine vielen einzelnen Zellzugriffe. Das braucht halt. Besser erst daten sammeln und dann auf einen Schlag in die Zellen schreiben.
Beispiel:
Sub Ruestwechsel()
'Deklarationen der Variablen
Dim cntr As Long, c As Range, i As Long, Zeilenzahl As Long, Zeilenzahl2 As Long, StartDatum As  _
Date, EndDatum As Date, n
Dim Summe, loLetzte As Long, loSpalte, pctCompl As Integer, vntRet As Variant, vorgang As  _
String, d As Variant, j As Long
Dim hilfsdatum As String
Dim tt
Application.ScreenUpdating = False
'Fortschrittsbalken auf 0 setzen
progressg pctCompl
'Gesuchtes Datum eingeben
hilfsdatum = InputBox("Bitte geben Sie ein Startdatum ein:")
If hilfsdatum = "" Then Exit Sub
StartDatum = hilfsdatum
hilfsdatum = InputBox("Bitte geben Sie ein Enddatum ein:")
If hilfsdatum = "" Then Exit Sub
EndDatum = hilfsdatum
'Ausgabe- und Hilfsblätter leeren
Worksheets("Hilfstabelle").Cells.Clear
With Worksheets("Linienauswertung - Grafiken")
.Cells.Clear
.Cells(1, 1).Resize(6, 4) = LiesRuestWechsel(StartDatum, EndDatum)
.Cells(8, 1).Resize(6, 4) = LiesRuestZeit(StartDatum, EndDatum)
End With
'Bis hier bei mir 0,004 Sekunden
'Alle 5 Linien
For i = 2 To 6
'Blatt leeren und beschriften
With Worksheets("Hilfstabelle")
.Range("A1").CurrentRegion.Clear
.Range("A1").Resize(, 6) = Array("Barcode", "Masterbarcode", "Schicht", "LP Nutzen", "Datum" _
, "Uhrzeit")
Function LiesRuestWechsel(StartDatum As Date, EndDatum As Date)
Dim arr(1 To 6, 1 To 4)
Dim i As Integer, j As Long
Dim vArr
arr(1, 1) = "Rüstwechsel"
arr(1, 2) = "Früh"
arr(1, 3) = "Spät"
arr(1, 4) = "Nacht"
'Alle 5 Linien
For i = 2 To 6
arr(i, 1) = "R" & i - 1
arr(i, 1) = "R" & i - 1
'Tabellenblatt der Linie
With Worksheets("R" & i - 1)
'Rüstwechsel zählen und ausgeben
vArr = .Cells(1, 1).CurrentRegion.Resize(, 14)
For j = 3 To UBound(vArr)
Select Case vArr(j, 13)
Case StartDatum To EndDatum
If vArr(j, 1)  vArr(j - 1, 1) Then
Select Case vArr(j, 6)
Case "FS"
arr(i, 2) = arr(i, 2) + 1
Case "SS"
arr(i, 3) = arr(i, 3) + 1
Case "NS"
arr(i, 4) = arr(i, 4) + 1
End Select
End If
End Select
Next j
End With
Next i
LiesRuestWechsel = arr
End Function

Function LiesRuestZeit(StartDatum As Date, EndDatum As Date)
Dim arr(1 To 6, 1 To 4)
Dim i As Integer, j As Long
Dim vArr
arr(1, 1) = "Rüstwechsel"
arr(1, 2) = "Früh"
arr(1, 3) = "Spät"
arr(1, 4) = "Nacht"
'Alle 5 Linien
For i = 2 To 6
arr(i, 1) = "R" & i - 1
arr(i, 1) = "R" & i - 1
'Tabellenblatt der Linie
With Worksheets("R" & i - 1)
vArr = .Cells(1, 1).CurrentRegion.Resize(, 14)
For j = 3 To UBound(vArr)
Select Case vArr(j, 13)
Case StartDatum To EndDatum
If vArr(j, 1)  vArr(j - 1, 1) Then
Select Case vArr(j, 6)
Case "FS"
arr(i, 2) = arr(i, 2) + vArr(j, 5)
Case "SS"
arr(i, 3) = arr(i, 3) + vArr(j, 5)
Case "NS"
If vArr(j, 14) > TimeSerial(21, 59, 59) Then
arr(i, 4) = arr(i, 4) + vArr(j, 5)
End If
End Select
End If
End Select
Next j
End With
Next i
LiesRuestZeit = arr
End Function

weiter geht's hinten mit Zeilen löschen etc. bei der Optimierungsfähigkeit weiter.
Gruß
Rudi
Anzeige
AW: Performance letzter Schritt
08.03.2018 07:26:00
Burak
Erst einmal auch dir Sorry für die späte Antwort, hatte gestern unerwartet "frei".
Zu deinem Makro:
Das funktioniert schonmal episch gut! Nur ein kleines Manko. Im Ausgabeblatt werden keine Nullen mehr geschrieben, wenn es keine Rüstwechsel und dementsprechend keine Rüstwechselzeiten gab.
Ich arbeite mich jetzt erstmal Stück für Stück in deinen Code, dass ich ihn verstehe und auch auf den Rest des Makros anwenden kann.
Vielen Dank dir schonmal für diese tolle Leistung!!! :*
PS: Hattest du auch das Problem, dass du die Datei nicht runterladen konntest?
AW: Performance letzter Schritt
08.03.2018 11:57:23
Rudi
Hallo,
0 statt leer (für die andere Function entsprechend):
Function LiesRuestWechsel(StartDatum As Date, EndDatum As Date)
Dim arr(1 To 6, 1 To 4)
Dim i As Integer, j As Long
Dim vArr
'Array vorbereiten
arr(1, 1) = "Rüstwechsel"
arr(1, 2) = "Früh"
arr(1, 3) = "Spät"
arr(1, 4) = "Nacht"
For i = 2 To 6
For j = 2 To 4
arr(i, j) = 0
Next j
Next i
'Alle 5 Linien
For i = 2 To 6
arr(i, 1) = "R" & i - 1
arr(i, 1) = "R" & i - 1
'Tabellenblatt der Linie
With Worksheets("R" & i - 1)
'Rüstwechsel zählen und ausgeben
vArr = .Cells(1, 1).CurrentRegion.Resize(, 14)
For j = 3 To UBound(vArr)
Select Case vArr(j, 13)
Case StartDatum To EndDatum
If vArr(j, 1)  vArr(j - 1, 1) Then
Select Case vArr(j, 6)
Case "FS"
arr(i, 2) = arr(i, 2) + 1
Case "SS"
arr(i, 3) = arr(i, 3) + 1
Case "NS"
arr(i, 4) = arr(i, 4) + 1
End Select
End If
End Select
Next j
End With
Next i
LiesRuestWechsel = arr
End Function
PS: Hattest du auch das Problem, dass du die Datei nicht runterladen konntest?
Dumme Frage! Wie hätte ich sonst an deinen Code kommen sollen? ;-)
Gruß
Rudi
Anzeige
Danke
09.03.2018 07:21:34
Burak
Zu Beginn der Funktion erstmal alle Werte auf 0 setzen... darauf hätte ich auch kommen können :(
Ja die Frage mit dem Datei runterladen habe ich nie gestellt. das musst du dir eingebildet haben! :D
Danke dir auf jeden Fall!
Fehler gefunden!
09.03.2018 08:34:54
Burak
Da bin ich nochmal Rudi,
mir ist da noch ein "Fehler" in deinem Makro aufgefallen.
Es geht um die Nachtschicht "NS" in deinem Makro.
Die Nachtschicht geht von 22:00 Uhr bis 6:00 Uhr am nächsten morgen. Dementsprechend soll bei Case "NS" auch bis 6 Uhr für "EndDatum + 1" gelten. Ich versuche auch grade das iwie umzusetzen. Vllt siehst und setzt du das schneller als ich um :D
Freundliche Grüße
Anzeige
Fehler gelöst!
09.03.2018 08:48:00
Burak
Hab es doch schneller hinbekommen als gedacht! Jetzt endgültig erledigt! Danke nochmal

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige