Hallo im Rahmen meiner Masterarbeit muss ich diverse Auswertungen durchführen. Ich habe dafür ein VBA Makro geschrieben, welches auch funktioniert, jedoch nur bei geringen Datenmengen. Ich bräuchte ein Makro, was genau das gleiche erledigt, jedoch in viel schnellerer Zeit. Wir reden hier von einer Laufdauer von fast 2 h bei den Datenmengen. Worum gehts?: Es geht um Einsätze an Maschinen. Jede Zeile in den Basisdaten stellt einen Einsatz da. Die Basisdaten enthalten pro jahr 150.000 Einsätze. Ich würde gerne 4 Jahre einfügen falls möglich. Es werden jedoch mindestens 1 Jahr und 1 Monat an Daten in den Basisdaten benötigt.  Über eine Eingabemaske wählt man den Auswertungszeitraum aus, und es werden aus den Basisdaten nur die Einsätze herausgefiltert, welche relevant sind. Der Auswertungszeitraum ist jedoch flexibel wählbar. In den meisten Fällen beträgt er einen Monat, was ungefähr 10-15.000 Einsätzen entpsricht.  Für jeden Einsatz der sich im Auswertungszeitraum befindet müssen 2 Prüfungen vorgenommen werden. 1. Prüfung. Ist der Einsatz im Auswertungszeitraum ein Ersteinsatz oder ein Mehrfacheinsatz. Das wird geprüft in dem man für jeden Einsatz im Auswertungszeitraum, x Tage in die Vergangenheit schaut und Prüft ob ein Einsatz an der gleichen Masschine vorgelegen hat. (Den Zeitraum für die Rückwärtsrechnung gibt man auch in der Eingabemaske ein). Die 2 Prüfung ist genau das gleiche nur das man anstatt in die Vergangenheit, in die Zukunft für einen bestimmten Zeitraum schaut. Liegt in der Zukunft ein Einsatz vor so ist der Einsatz im Auswertungszeitraum nicht erfolgreich gewesen. Ich habe eine Beispieldatei, die ich gerne zukommen lassen kann. Ich denke nicht, dass es so klar wird wenn ich den code hier darstelle: Trotzdem anbei der Code: Kurze Erklärung: Spalte 6 =Einsatzdatum Spalte 4 =Maschinennummer

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 <= Ende Then
            Sheets("Betrachtungszeitraum_klein").Range(Counter1 & ":" & Counter1).Value = . _
Range(row & ":" & row).Value
            Counter1 = Counter1 + 1
        End If
    
         If .Cells(row, 6).Value >= Anfang - Rueckwaertsdauer And .Cells(row, 6).Value <= Ende + _
 _
 Vorwaertsdauer Then
            Sheets("Betrachtungszeitraum_all").Range(Counter2 & ":" & Counter2).Value = .Range(  _
_
row & ":" & row).Value
            Counter2 = Counter2 + 1
        End If
        
    Next row

End With

End Sub


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
           MFE = MFE + 1
        End If

     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 + Vorwaertsdauer > 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