Live-Forum - Die aktuellen Beiträge
Anzeige
Archiv - Navigation
1676to1680
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

Makro beschleunigen

Makro beschleunigen
18.02.2019 15:44:32
Dennis
Hallo,
im Rahmen meiner Masterarbeit muss ich mehrere Auswertungen durchführen. In Zusammenarbeit mit meinem Studienkollgen habe ich dafür ein Programm geschrieben, jedoch erlaubt die Dauer des Makros keine Auswertung durchzuführen. Ich habe eine Datenliste von 200.000 Zeilen die durchlaufen werden müssen. Selbst wenn ich die Datenmenge um den Faktor 20 kürze, brauchen die beiden Makros insgesamt 25 Minuten.Vorab, ich bin ein VBA Neuling.
Meine Rohdaten umfassen 11 Spalten. Wichtig für die beiden Makros sind jedoch nur 3 Spalten. Spalte 4 enthält Maschinennummern, Spalte 5 entählt das Datum der Kundenmeldung und Spalte 6 das Datum des Einsatz.
Über eine Eingabemaske wird ein Zeitraum eingegeben (Auswertungszeitraum), welcher in den meisten Fällen immer einen Monat beträgt. . Weiterhin wird in der Eingabemaske die Dauer der Rückwärtsbetrachtung (180d in den meisten Fällen) und die Dauer der Vorwärtsbetrachtung (180d) eingegeben.
Makro 1 filtert die Basisdaten und schreibt alle Daten, die sich im Auswertungszeitraum befinden in ein neues Blatt "Betrachtungszeitraum_klein" Im zweiten Schritt werden alle Daten die sich im Zeitraum Auswertungszeitraum Anfang -Rückwertsdauer und Auswertungszeitraum Ende + Vorwärtsdauer befinden in ein neues Blatt "Betrachtungszeitraum_all" geschrieben.
Dafür folgendes Makro. Das braucht bei einer Basisdatenmenge von 15000 Zeilen schon 10 Minuten und eigentlich soll eine Menge von 200.000 Zeilen durchlaufen werden.
Sub Filter_Data()
Dim Counter1 As Long
Dim Counter2 As Long
Dim row As Long
Dim lastrow_basis As Long
Counter1 = 2
Counter2 = 2
With Worksheets("Basisdaten")
lastrow_basis = .Cells(Rows.Count, "A").End(xlUp).row
For row = 2 To lastrow_basis
If .Cells(row, 6).Value >= Anfang And .Cells(row, 6).Value = Anfang - Rueckwaertsdauer And .Cells(row, 6).Value 
Das zweite Makro ist ein bisschen komplexer. Kurze Defintion: MFE= Mehrfacheinsatz(Dem Einsatz im Auswertungszeitraum sind Einsätze im Zeitraum Einsatzdatum bis Einsatzdaum-Rückwärtsdauer)vorausgegangen.
Erfolg = kein weiterer Einsatz an der gleichen Maschine innerhalb Zeitraum(Einsatzdatum bis Einsatzdatum+Vorwärtsdauer.
Für jeden Einsatz im Auswertungszeitraum soll geprüft werden, ob dieser Erolgreich war und wie viele Einsätze diesem Vorausgegangen sind. MFE0 = kein Einsatz vorausgegangen, MFE1 = ein einsatz vorausgegangen...
Folgendes Makro dafür. Dieses braucht bei einer Datenmenge von 15000 Zeilen 15 Minuten...
Sub Calculate1()
Dim row1 As Long
Dim row2 As Long
Dim lastrow_klein As Long
Dim lastrow_all As Long
Dim MFE As Integer
Dim Erfolg_Einsatz As Integer
lastrow_klein = Sheets("Betrachtungszeitraum_klein").Cells(Rows.Count, "A").End(xlUp).row
lastrow_all = Sheets("Betrachtungszeitraum_all").Cells(Rows.Count, "A").End(xlUp).row
MFE = 0
For row1 = 2 To lastrow_klein
For row2 = 2 To lastrow_all
If Sheets("Betrachtungszeitraum_klein").Cells(row1, 4).Value =                           _
_
Sheets("Betrachtungszeitraum_all").Cells(row2, 4).Value And _
Sheets("Betrachtungszeitraum_klein").Cells(row1, 6).Value > Sheets(" _
Betrachtungszeitraum_all").Cells(row2, 6).Value And _
Sheets("Betrachtungszeitraum_klein").Cells(row1, 6).Value - Rueckwaertsdauer  Sheets(" _
_
Betrachtungszeitraum_all").Cells(row2, 6).Value Then
Erfolg_Einsatz = Erfolg_Einsatz + 1
End If
Next row2
Sheets("Betrachtungszeitraum_klein").Cells(row1, 12).Value = MFE
Sheets("Betrachtungszeitraum_klein").Cells(row1, 13).Value = Erfolg_Einsatz
MFE = 0
Erfolg_Einsatz = 0
Next row1
End Sub

Ich hoffe ihr könnt mir weiterhelfen. Bin wie gesagt ein Neuling..

37
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Array
18.02.2019 16:19:19
Fennek
Hallo,
es wird erheblich schneller, wenn man zuerst alle relevanten Zellen auf einmal in ein Array schreibt, dort alle Berechnungen vornimmt und das Array auf einmal zurück schreibt. Je nach den Details kann es ca 100 x schneller werden.
Es ist zu mühsam aus dem gezeigten Code die Daten zu vermuten, lade doch eine kleine Datei hoch, die aber in der Struktur mit dem Original übereinstimmt. 10-20 Datenätze sollten reichen.
mfg
AW: Array
18.02.2019 16:35:14
Dennis
Vielen Dank für die schnelle Antwort. Ich bin leider erst morgen Früh wieder auf der Arbeit. Ich lade dann morgen eine Datei hoch mit den Arbeitsblättern Basisdaten, Betrachtungszeitraum_klein, Betrachtungszeitraum _All. Da sieht man dann, was das Makro mit den Basisdaten gemacht hat. Dann wird das alles verständlicher. Ich hoffe wir können die Makrolaufzeit um einiges kürzen, sonst kann ich wirklich keine Auswertung machen. Danke schon mal vorab:)
Anzeige
AW: Makro beschleunigen
19.02.2019 18:34:12
Dennis
ich bin leider nicht früher dazu gekommen. ich erkläre nochmal kurz was das Makro können soll.
Es gibt im Blatt Basisdaten eine Vielzahl von Maschinen mit verschiedenen Einsatzdaten. Über eine Eingabemaske wird gefiltert, welchen Auswertungszeitraum man sich anschaut. In diesem Fall ist es der 01.06.2017-30.06.2017. Die Rückwärtsdauer beträgt 180 Tage und die Vorwärtsdauer auch. Im Blatt Betrachtungszeitraum_klein wird jeder Einsatz reinkopiert, der sich im Juni befindet. Im Blatt Betrachtungszeitraum_all werden alle Einsatze reinkopiert, die sich im Zeitraum 01.06.2017-180d und 30.06.2017+180d befinden. Wichtig ist das jeder Einsatz der sich im Auswertungszeitraum befindet nach Erfolg und Mehrfacheinsatz bewertet. Dafür wird für jeden Einsatz im Auswertungszeitraum 180d zurückgeschaut und man überprüft ob ein weiterer Einsatz an der selben Anlage vorgelegen hat. Liegt ein Einsatz vor, dann ist der Einsatz im Auswertungszeitraum ein MFE1 und so weiter.. Des Weiteren wird für jeden Einsatz 180d vorgeschaut und überprüft ob in diesem Zeitraum ein weiterer Einsatz gefolgt ist. Die Datei ist eine sehr stark abgespeckte Beispieldatei. Befinden sich im Auswertungszeitraum 15000 Einsätze so dauert der Vorgang 25 Minuten was viel zu lange ist.. Ich hoffe mir kann geholfen werden.
Anzeige
AW: Makro beschleunigen
20.02.2019 15:38:35
PeterK
Hallo
Eine verbesserte Version meiner Filter_Data von 15:25

Sub Filter_Data()

    Dim lastrow_basis As Long
    Dim lastrow_all As Long

    Debug.Print "Start Filter:", Timer

    With Worksheets("Basisdaten")

        lastrow_basis = .Cells(Rows.Count, "A").End(xlUp).row

        .Range("$A$1:$K$" & lastrow_basis).AutoFilter Field:=5, _
                                                      Criteria1:=">=" & CDbl(Anfang - Rueckwaertsdauer), _
                                                      Operator:=xlAnd, _
                                                      Criteria2:="<=" & CDbl(Ende + Vorwaertsdauer)

        .Range("A2:K" & lastrow_basis).Copy Worksheets("Betrachtungszeitraum_all").Range("A2")
        .Range("$A$1:$K$" & lastrow_basis).AutoFilter

    End With

    With Worksheets("Betrachtungszeitraum_all")

        lastrow_all = .Cells(Rows.Count, "A").End(xlUp).row

        .Range("$A$1:$K$" & lastrow_all).AutoFilter Field:=5, _
                                                    Criteria1:=">=" & CDbl(Anfang), _
                                                    Operator:=xlAnd, _
                                                    Criteria2:="<=" & CDbl(Ende)

        .Range("A2:K" & lastrow_all).Copy Worksheets("Betrachtungszeitraum_klein").Range("A2")
        .Range("$A$1:$K$" & lastrow_all).AutoFilter

    End With

    Debug.Print " End Filter:", Timer
End Sub

VBA/HTML-CodeConverter, AddIn für Office 2002-2016 - in VBA geschrieben von Lukas Mosimann. Projektbetreuung:RMH Software & Media

Code erstellt und getestet in Office 15 - mit VBAHTML 12.6.0


Anzeige
AW: Teil 1
19.02.2019 19:50:51
Fennek

'benötigt Sheets("klein") und Sheets("alle")
Const Anfang As Date = #1/1/2017#
Const Ende As Date = #6/30/2017#
Const DD As Integer = 30 'anstelle von 180
Sub Filter_Data()
Ar = Sheets("Basisdaten").Range("A1").CurrentRegion
ReDim Br(UBound(Ar), UBound(Ar, 2)) 'Betrachtungszeitraum Klein
ReDim Cr(UBound(Ar), UBound(Ar, 2)) 'Betrachtungszeitraum Groß
For i = 2 To UBound(Ar)
If Ar(i, 2) >= Anfang And Ar(i, 2) = Anfang - DD And Ar(i, 2) 
Teste mal, ob das passt.
AW: Teil 1 und Teil 2
19.02.2019 20:53:39
Fennek
Hallo,
mit den Beispiel-Daten kann ich das Makro nicht inhaltlich testen, bitte prüfe es gründlich.

'benötigt Sheets("klein") und Sheets("alle")
Const Anfang As Date = #1/1/2017#
Const Ende As Date = #6/30/2017#
Const DD As Integer = 30 'anstelle von 180
Sub Filter_Data()
Anf = Timer
Ar = Sheets("Basisdaten").Range("A1").CurrentRegion
ReDim Br(UBound(Ar), UBound(Ar, 2)) 'Betrachtungszeitraum Klein
ReDim Cr(UBound(Ar), UBound(Ar, 2)) 'Betrachtungszeitraum Groß
For i = 2 To UBound(Ar)
If Ar(i, 2) >= Anfang And Ar(i, 2) = Anfang - DD And Ar(i, 2)  Cr(ii, 2) _
And Br(i, 2) - DD  Cr(ii, 2) Then Erfolg = Erfolg + 1
Next ii
Br(i, UBound(Br, 2) - 1) = MFE
Br(i, UBound(Br, 2)) = Erfolg
MFE = 0
Erfolg = 0
Next i
Sheets("klein").Range("A2").Resize(UBound(Br), UBound(Br, 2)) = Br
Sheets("alle").Range("A2").Resize(UBound(Cr), UBound(Cr, 2)) = Cr
MsgBox Timer - Anf
End Sub
Berichte bitte über die Geschwindigkeit.
mfg
Anzeige
AW: Korrektur
20.02.2019 08:57:05
Fennek
Hallo,
jetzt kann das Makro die gezeigten Werte weitgehend, aber nicht ganz nachvollziehen.
Am Anfang werden die Spalten der M.-Nr. und des Datums übergeben, damit ist die Anpassung an die Originaldatei einfacher.

'benötigt Sheets("klein") und Sheets("alle")
Const Anfang As Date = #1/1/2017#
Const Ende As Date = #6/30/2017#
Const DD As Integer = 180 'anstelle von 180
Sub Filter_Data()
Anf = Timer
MA = 1 'Spalte der Maschinen-Nr.
DA = 2 'Spalte des Datums
Ar = Sheets("Basisdaten").Range("A1").CurrentRegion
ReDim Br(UBound(Ar), UBound(Ar, 2)) 'Betrachtungszeitraum Klein
ReDim Cr(UBound(Ar), UBound(Ar, 2)) 'Betrachtungszeitraum Groß
For i = 2 To UBound(Ar)
If Ar(i, DA) >= Anfang And Ar(i, DA) = Anfang - DD And Ar(i, DA)  Cr(ii, DA - 1) _
And Br(i, DA - 1) - DD  Cr(ii, DA - 1) Then Erfolg = Erfolg + 1
Next ii
Br(i, UBound(Br, 2) - 1) = MFE
Br(i, UBound(Br, 2)) = Erfolg
MFE = 0
Erfolg = 0
Next i
Sheets("klein").Range("A2").Resize(UBound(Br), UBound(Br, 2) + 1) = Br
Sheets("alle").Range("A2").Resize(UBound(Cr), UBound(Cr, 2)) = Cr
MsgBox Timer - Anf
End Sub
mfg
Anzeige
AW: Korrektur
20.02.2019 13:43:37
Dennis
ich bins nochmal. Mit deinem Makro funktioniert das irgendwie nicht. Im Anhang befindet sich eine Beispieldatei. Das Makro macht auch das was es machen soll. Leider dauert der Vorgang bei einer größeren Datenmenge unerlässlich lang. Im Blatt Basisdaten werden sich wenn ich die Auswertung machen soll ca 150.000-200.000 Zeilen befinden und davon werden bei monatlicher Auswertung ca. 10.000 in das Blatt Betrachtungszeitraum klein rutschen. Jeder dieser Werte muss auf MFE und Erfolg geprüft werden. Es gibt 2 Erfolgsprüfungen. Erfolg Einsatz bezieht sich auf das Datum Kundendiensteinsatz und Erfolg Meldung bezieht sich auf das Datum Kundenmeldung. (Für Folgeeinsätze wird dann entweder das Datum Kundendiensteinsatz genommen oder das Datum der Kundenmeldung und dann geschaut ob diese innerhalb der Vorwaertsdauer liegen. Mit dieser kleinen Datenmenge funktioniert das Programm, aber wie gesagt mit einer größeren Datenmenge kann ich für eine monatliche Auswertung schon mal 1-2h warten und das ist nicht tragbar... Ich hoffe du/ihr könnt mir helfen. Anbei die Datei
https://www.herber.de/bbs/user/127787.xlsm
Anzeige
AW: Korrektur
20.02.2019 15:25:48
PeterK
Hallo
Ich hab mal Filter_Data umgeschrieben
Sub Filter_Data()

    Dim lastrow_basis As Long

    Debug.Print "Start Filter:", Timer

    With Worksheets("Basisdaten")

        lastrow_basis = .Cells(Rows.Count, "A").End(xlUp).row
        
        .Range("$A$1:$K$" & lastrow_basis).AutoFilter Field:=5, Criteria1:= _
        ">=" & CDbl(Anfang), Operator:=xlAnd, Criteria2:="<=" & CDbl(Ende)

        .Range("A2:K" & lastrow_basis).Copy Worksheets("Betrachtungszeitraum_klein").Range("A2")
        
        .Range("$A$1:$K$" & lastrow_basis).AutoFilter Field:=5, Criteria1:= _
        ">=" & CDbl(Anfang - Rueckwaertsdauer), Operator:=xlAnd, Criteria2:="<=" & CDbl(Ende + Vorwaertsdauer)

        .Range("A2:K" & lastrow_basis).Copy Worksheets("Betrachtungszeitraum_all").Range("A2")

        .Range("$A$1:$K$" & lastrow_basis).AutoFilter

    End With
    
    Debug.Print " End Filter:", Timer
End Sub

VBA/HTML-CodeConverter, AddIn für Office 2002-2016 - in VBA geschrieben von Lukas Mosimann. Projektbetreuung:RMH Software & Media

Code erstellt und getestet in Office 15 - mit VBAHTML 12.6.0


Anzeige
AW: Korrektur
20.02.2019 15:40:59
Dennis
Danke, werde ich probieren. Vielleicht ein Vorschlag für die MFE Kategorisierung und Erfolgsrechnung? Das frisst leider am meisten Zeit..
AW: Korrektur
20.02.2019 15:59:09
PeterK
Hallo
Bin ich noch dabei (ich hab eine 2. Version von Filter_Data eingestellt, die noch eine Spur schneller sein sollte :-) ) Ich bleib jetzt mit meinen Antworten auf deisem Ast
AW: Korrektur
21.02.2019 09:56:10
Dennis
Habe den Filter ausprobiert. Funktioniert super. Das Problem ist leider nach wie vor die Erfolgsrechnung und die MFE Kategorisierung. Im Betrachtungszeitraum all werden sich dann 110.000 Daten befinden und im Betrachtungszeitraum klein 6000-15000.
AW: Korrektur
21.02.2019 10:02:55
PeterK
Kannst Du diese 110.000 Daten als CSV gezippt hier einstellen
Anzeige
AW: Korrektur
21.02.2019 11:43:34
Dennis
Als Excel Datei 6 MB und als CSV Datei 1 MB. könnte es per mail senden.
AW: Korrektur
21.02.2019 11:59:26
Dennis
Oder Einfach 110.000 Zufallsdaten generieren. Im Auswertungszeitraum müssten dann 10.000 Daten sein, die sich durch die Rückwärtsbetrachtung und Vorwärtsbetrachtung mit 110.000 Daten abgleichen.
AW: Korrektur
22.02.2019 09:43:55
PeterK
Hallo Dennis
Danke für die Daten. Ich hab eine Version ohne Array erstellt,die bei mir ca. 1 Minute braucht (110.000 zu 13.000 Datensätzen). Wie Du Wann Was zählst hab ich "unverändert" von Dir übernommen, hab aber Deine "If" optimiert (Anmerkung: Bei If mit AND Bedingungen werden immer ALLE Bedingungen überprüft unabhängig davon ob die Erste bereits FALSE ergibt!). Wichtig ist das die 4.Spalte in den BasisDaten als Nummer formatiert wird (Procedure ConvertToNumber, es findet in Filter_Daten aber nur eine rudimentäre Prüfung statt) da sonst MATCH ewig braucht (Stringvergleich versus Zahlenvergleich)
https://www.herber.de/bbs/user/127830.xlsm
Anzeige
AW: Korrektur
22.02.2019 11:13:27
Dennis
Danke ich teste und melde mich =)
AW: Korrektur
22.02.2019 13:18:48
Dennis
Der Oberhammer. Funktioniert rasend schnell. Vielen Dank. Jetzt muss ich es nur noch eingebaut bekommen.
AW: Korrektur
22.02.2019 13:52:14
PeterK
Hallo Dennis
Ich hab noch etwas für Dich (~20 Sekunden)
https://www.herber.de/bbs/user/127852.xlsm
Folgendes Voraussetzungen: BASIS Spalte 4 muss numerisch sein und aufsteigend sortiert (derzeit noch händisch zu machen). In .._All wird eine Hilfsspalte eingefügt (so kann ich dann mit VLookUp arbeiten, was um einiges schneller ist als Match)
AW: Korrektur
21.02.2019 11:59:55
PeterK
Hallo
CSV an peter.kreimer@gmx.at
AW: Korrektur
21.02.2019 10:31:30
Dennis
Ja ich muss die Daten nur ändern und lasse es dann nochmal mit Fenneks Makro durchlaufen und lade die Datei dann hier hoch. Problem ist die Laufdauer, aber schomal wesentlich besser als vorher aber wenn man irgendwas um die 10-15 Minuten Laufzeit hinbekommen kann wäre das super. Fenneks Makro berechnet den Erfolg bisher nur auf Einsatzdatumbasis, der müsste noch auf Basis der Kundenmeldung eingefügt werden. Also für Einsätze im Auswertungszeitraum wirdüber eine Vorwärtsbetrachtung geschaut, ob ein weiterer in der Zukunft gefolgt ist. Als Zeitpunkt für Folgeinsätze soll dafür einmal die Kundenmeldung als Basis genommen werden und einmal das Einsatzdatum. Ist jeweils die gleiche Erfolgsprüfung nur mit unterschiedlichen Zeitpunkten der Folgeeinsätze.
AW: Korrektur
20.02.2019 16:10:44
Dennis
Wo finde ich die zweite Version von Filter Data? Okay ich freue mich auf Ihren Vorschlag. Kann diesen leider erst morgen testen.
AW: Korrektur
21.02.2019 08:53:41
PeterK
Hallo
Könntest Du mal einen größere Basis zur Verfügung stellen? Am Beste als CSV und komprimiert.
AW: Makro beschleunigen
20.02.2019 12:22:01
Daniel
Hi
probier mal folgende Variante:
kopiere einfach alle Daten in die neue Datei und lösche dann die nicht benötigten Zeilen.
das Löschen der Zeilen geht nach folgender Methode auch mit größten Datenmengen recht zügig:
1. schreibe in die erste freie Spalte am Tabellenende eine Formel, welche alle Zeilen, die gelöscht werden müssen mit 0 markiert und alle die stehen bleiben sollen mit der aktuellen Zeilennummer (Zeile())
2. schreibe in die Überschriftenzeile der Hilfsspalte die 0
3. Wende auf die ganze Tabelle die Menüfunktion DATEN - DATENTOOLS - DUPLIKATE ENTFERNEN an mit der Hilfsspalte als Kriterium und der Option "keine Überschrift"
4. lösche die Hilfsspalte wieder.
probier das erstmal von Hand aus und dann siehst du ja, wie schnell das löschen geht.
wenn das für dich passt, kannst du ja dieses Vorgehen in VBA umsetzen (der Recorder ist dein Freund)
Gruß Daniel
AW: Makro beschleunigen
20.02.2019 14:28:17
Dennis
Hallo Daniel, für das Filtern der Daten ist wahrscheinlich eine Lösung gefunden. Bin jedoch gerne offen für andere Vorschläge. Jedoch für das Kategorisieren welche Art MFE hilft es ja nicht die Daten zu kürzen. Da muss man ja auf ein ganzes Jahr an Daten zurückgreifen und abgleichen. Dafür muss eine schnellere Variante gefunden werden, als die ich jetzt hochgeladen habe..
AW: Makro beschleunigen
20.02.2019 14:36:32
Daniel
Hi
Du kannst bsp die Liste nach Vorfall und Datum sortieren.
Dann könntest du mit einer einfachen Formel abfragen, ob das Datum im Bereich liegt, und dann mit Vorgänger- und Nachfolgerzelle vergleichen, um den Typ zu ermitteln.
Im Sortieren ist Excel sehr schnell, das sollte man ausnutzen, wenn such durch eine geschickte Sortierung solche Auswertungen vereinfachen lassen.
Gruß Daniel
AW: Makro beschleunigen
20.02.2019 15:03:42
Dennis
das würde gehen, aber nur der vergleich mit vorgänger und nachfolgerzeile geht nicht, da die gleiche anlage x beliebig mal vorkommen kann. dann müsste nicht nur mit der vorgänger und nachfolgerzeile verglichen werden sondern mit x beliebigen zeilen. realistisch ist das eine anlage im jahr nicht mehr als 20 mal vorkommt, aber mir wäre es doch lieber würde das alles automatisch über ein programm ablaufen. muss diese auswertung sehr oft durchführen.
AW: Makro beschleunigen
20.02.2019 15:18:23
Daniel
Hi
wenn du die Liste sortierst, musst du nicht jedesmal jeden Eintrag mit allen anderen vergleichen, sondern vielleicht nur mit den nächsten 20-30 oder soweit, bis die nächste Anlage kommt.
auch wenn du programmierst, kannst du über eine geschickte Sortierung Rechenaufwand vermeiden.
Gruß Daniel
AW: Code funktioniert!
20.02.2019 15:17:56
Fennek
mit MA=3 und DA=6 werden die Werte wie in der Vorlage berechnet.
In der ersten Vorlage gab es nur "Erfolg", nicht unterschieden in "Einsatz" und "Meldung"
AW: Code funktioniert!
20.02.2019 15:40:14
Dennis
Stimmt, das hatte ich vergessen. Der Erfolg wird gleich berechnet nur einmal zieht man als Bezugsdatum für Folgeeinsätze die Kundenmeldung heran und einmal den Kundendiensteinsatz. Bei mir funktioniert dein Makro nicht. Kannst du vielleicht die Excel Datei mit deinem eingefügten Makro hier hochladen? Das wäre sehr hilfreich. Danke.
AW: Datei
20.02.2019 16:09:10
Dennis
Jetzt funktioniert es. Nur ändern sich bei mir nur das Blatt klein und alle aber nicht Betrachtungszeitraum klein und Betrachtzungszeitraum_all wenn ich den Auswertungszeitraum änder. Ich kann es leider erst morgen mit einer großen Datenmenge ausprobieren. Wenn kein Einsatz in der Vergangenheit leer ist, bleibt eine leere Zeile. Wie ändere ich das, damit da 0 steht? Wäre es vllt noch möglich die Erfolgsrechnung mit dem Bezugsdatum Kundenmeldung für Folgeeinsätze einzubauen?
AW: Datei
21.02.2019 09:44:35
Dennis
Habe deine Datei mal mit Daten gefüttert. Basisdaten 107000 Zeilen. Vor- und Rückwärtsrechnung 180d. Zeitraum ein Monat, was 6000 Einsätzen enstpricht. Die Laufdauer des Makros betrug 27 Minuten. Liegt das an der Rechnerleistung oder ist da noch Optimierungspotential oder leider nicht schneller machbar? Muss diese Auswertung für 48 Monate und unter umständen auch für andere Filter vornehmen. 27 Minuten pro Auswertung ist da schon echt heftig..
AW: Teil 1: 0,5 Sek
21.02.2019 14:04:01
Fennek
Hallo,
mit mehrfachen Kopierens der vorhanden Daten habe ich mit 180.000 Zeilen getestet:
Teil 1 braucht mit 0,5 Sekunden so viel wie erwartet.
Teil 2 braucht für 200 (von 180.000) 30 Sekunden
In Teil 2 sind 180.000 ^2 Durchläufe nötig, recht viel!
Wenn man die "and" Verknüpfung auflöst, geht es etwas schneller.
mfg
AW: halb so lange
21.02.2019 14:14:01
Fennek
mit diesem Code dauerten 1000 Durchläufe 34 anstelle 54 Sekunden.
Noch schneller sollte es werden, wenn man die Daten zuerst sortiert.

'benötigt Sheets("klein") und Sheets("alle")
'Const Anfang As Date = #1/1/2017#
'Const Ende As Date = #6/30/2017#
Const DD As Integer = 90 'anstelle von 180
Sub Filter_Data()
'Dim Anf As Date
'Dim MA As Integer, Da As Integer, i As Long
'Dim Ar(), Br(), Cr()
Anf = Timer
MA = 3 'Spalte der Maschinen-Nr.
Da = 6 'Spalte des Datums
With Sheets("Eingabemaske")
Anfang = .Cells(3, 3)
Ende = .Cells(3, 4)
End With
Ar = Sheets("Basisdaten").Range("A1").CurrentRegion
ReDim Br(UBound(Ar), UBound(Ar, 2)) 'Betrachtungszeitraum Klein
ReDim Cr(UBound(Ar), UBound(Ar, 2)) 'Betrachtungszeitraum Groß
For i = 2 To UBound(Ar)
If Ar(i, Da) >= Anfang And Ar(i, Da) = Anfang - DD And Ar(i, Da)  Cr(ii, Da - 1) Then
If Br(i, Da - 1) - DD  Cr(ii, Da - 1) Then Erfolg = Erfolg + 1
End If
End If
'If ii Mod 10000 = 0 Then Debug.Print ii, "Teil 2i", Timer - Anf
Next ii
Br(i, UBound(Br, 2) - 1) = MFE
Br(i, UBound(Br, 2)) = Erfolg
MFE = 0
Erfolg = 0
If i Mod 1000 = 0 Then Debug.Print i, "Teil 2i", Timer - Anf
Next i
Sheets("klein").Range("A2").Resize(UBound(Br), UBound(Br, 2) + 1) = Br
Sheets("alle").Range("A2").Resize(UBound(Cr), UBound(Cr, 2)) = Cr
MsgBox Timer - Anf
End Sub

AW: halb so lange
22.02.2019 13:22:22
Dennis
Danke auch nochmal an dich. Peter hat eine super Lösung gefunden.

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige