Office: (Office 2016) Makro arbeitet sehr langsam

Moin,

ich habe mir ein etwas aufwändigeres Excel-Projekt selbst zugemutet. Ich habe eine Anwesenheitstabelle für meine Mitarbeiter erstellt, in der die Teamsprecher täglich die anwesenden Kollegen eintragen, damit ich diese Daten in unser Arbeitszeitsystem übernehmen kann. Außerdem dient diese Datei im ernst Fall als Evakuierungsliste.
Grundsätzlich arbeiten wir mit 2 Schichten im 3-Schichtbetrieb (24h / 6 Tage pro Woche). Also werden aus beiden Schichten Mitarbeiter zur Nachtschicht eingeteilt. (Nur zur Erklärung, da die Datei für außenstehende etwas undurchsichtlich wirken kann).
Ich habe die gewünschten Makros selbst geschrieben und diese funktionieren auch soweit recht gut. Ich kann per Knopfdruck Sicherungs-PDF´s an einen vorgegebenden Ort speichern, die Anfangs- und Endzeit wird automatisch gesetzt, wenn der Teamsprecher den Kollegen als anwesend markiert. Mein "Problem-Makro" ist eher das ein- und ausblenden der unterschiedlichen Schichten (Früh-, Spät- und Nachtschicht). Zu allem Überfluss haben wir zwei unterschiedliche Frühschichtmodelle, zwei unterschiedliche Spätschichtmodelle und fünf (!!!) unterschiedliche Nachtschichtmodelle. Dann gibt es noch die Möglichkeit in versetzter Schicht (im Code "VER" genannt) zu arbeiten. Die Suche nach den jeweiligen Modellen (gerade die Nachtschicht) dauert bis zu 120 Sekunden.
Weiter unten seht ihr mein Code zum einblenden der Frühschicht. Gibt es eine Möglichkeit dies zu beschleunigen?

Des Weiteren suche ich immer in den Spalten nach den heutigen Datum und blende dann die gewünschte Schicht für den Tag ein. Da wir aber am Wochenende nicht immer alle Mitarbeiter anwesend haben, würden diese raus fallen und mit ausgeblendet werden. Ich hätte gern das nach der Kalenderwoche oder nach einem vorgegebenen Datum gesucht wird. Könnt ihr mir da helfen?

Private Sub CommandButton7_Click()
'Frühschicht raus filtern
Dim x
Dim y
With ActiveSheet
For x = 6 To 500 Step 9
For y = 5 To 33 Step 1
If Cells(x - 1, y) = Date Then
If Cells(x, y) = "F1" Then
Rows(x - 3).Hidden = False
Rows(x - 2).Hidden = False
Rows(x - 1).Hidden = False
Rows(x).Hidden = False
Rows(x + 1).Hidden = False
Rows(x + 2).Hidden = False
Rows(x + 3).Hidden = False
Rows(x + 4).Hidden = False
Rows(x + 5).Hidden = False
Else
If Cells(x, y) = "F2" Then
Rows(x - 3).Hidden = False
Rows(x - 2).Hidden = False
Rows(x - 1).Hidden = False
Rows(x).Hidden = False
Rows(x + 1).Hidden = False
Rows(x + 2).Hidden = False
Rows(x + 3).Hidden = False
Rows(x + 4).Hidden = False
Rows(x + 5).Hidden = False
Else
If Cells(x, y) = "VER" Then
Rows(x - 3).Hidden = False
Rows(x - 2).Hidden = False
Rows(x - 1).Hidden = False
Rows(x).Hidden = False
Rows(x + 1).Hidden = False
Rows(x + 2).Hidden = False
Rows(x + 3).Hidden = False
Rows(x + 4).Hidden = False
Rows(x + 5).Hidden = False
Else
Rows(x - 3).Hidden = True
Rows(x - 2).Hidden = True
Rows(x - 1).Hidden = True
Rows(x).Hidden = True
Rows(x + 1).Hidden = True
Rows(x + 2).Hidden = True
Rows(x + 3).Hidden = True
Rows(x + 4).Hidden = True
Rows(x + 5).Hidden = True
End If
End If
End If
End If
Next y
Next x
End With
Unload Schichtauswahl
'getestet und läuft
End Sub



Gruß Andre

 

Hallo,

Du könntest versuchen, ob das Ausschalten der Bildschirmaktualisierung eine leichte Besserung bringt.

Code:

Private Sub CommandButton7_Click()
  
  Dim x As Long
  Dim y As Long
  
  Application.ScreenUpdating = False
  
' :
' Dein Code
' :
  
  Application.ScreenUpdating = True
  
  Unload Schichtauswahl

End Sub

Allerdings ist anzumerken, dass in den neueren Excel-Version das zeilenweise Ein- und Ausblenden elendig langsam ist. Besser wäre es, wenn Du z.B. per Formel in einer Hilfspalte einen Wert errechnest, den Du per AutoFilter steuern kannst. Z.B. pro Zeile Frühschicht = 1, pro Zeile Spätschicht = 2 usw. Einen solchen AutoFilter kannst Du auch per Code steuern und das ist wesentlich schneller.

Gruß

 

Hey,

vielen Danke für die Hilfe.
ich hab deine Idee eingebaut, funktioniert soweit, bringt jedoch nicht die enorme Verbesserung.
Ich experimentiere nebenbei auch weiter herum.

Mein Ansatz das Makro zu beschleunigen ist zur Zeit, dass das Makro nicht mehr jeder Zeile und Spalte erneut nach dem Datum durch suchen soll, sondern dass nur noch in der Spalte nach den Ausdrücken "F1" oder "F2" in denen das heutige Datum steht.

im Code ausgedrückt:

Private Sub CommandButton8_Click()
'Spätschicht raus filtern
Dim x As Long
Dim y As Long
Dim z
Dim i As Range
For x = 6 To 497 Step 9
For z = x - 3 To x + 5
For y = i To lastrange 'hier soll aus der Variablen "i" der Variable "y" werden
Set i = ActiveSheet.Rows(5).Find(what:=Date, lookat:=xlWhole) 'hier soll nach dem Datum gesucht werden
If Cells(x + 2, y) = "F1" Then 'hier wird schon ein Fehler ausgeworfen...wen wundert es...
Rows(z).Hidden = False
Else
If Cells(x + 2, y) = "F2" Then
Rows(z).Hidden = False
Else
If Cells(x + 2, y) = "VER" Then
Rows(z).Hidden = False
Else
Rows(z).Hidden = True
End If
End If
End If
Next y
Next z
Next x
Unload Schichtauswahl
'wird getestet
End Sub

Der Code befindet sich noch im "aufbau"... habe aber das gefühl, dass ich mich im Kreis drehe...

Gruß Andre

 

Hallo,

wie gesagt, ein AutoFilter könnte die schnellste Variante sein. Google mal nach excel vba autofilter.

Gruß

 

Hallo Andre,

ausgehend von deinem 1. Code habe ich folgende Modifikation erstellt:

Code:

Option Explicit

Private Sub CommandButton7_Click()
 'Frühschicht raus filtern
 
  Dim x As Integer, y As Integer
  Dim VonBisZeilen As String
  Dim HeuteDatum As Date
  
  'Zelle A1 (bzw. irgendeine andere Zelle) enthält
  'Abfragedatum (statt des HEUTE()-Datums)
  HeuteDatum = Range("A1").Value
  
  
  With ActiveSheet
    For x = 6 To 500 Step 9
    
      'VonBisZeilen-Bereich (x-3) bis (x+5) soll ein/aus-geblendet werden:
      'Berechne diesen Bereich in der Variablen "VonBisZeilen":
      VonBisZeilen = (x - 3) & ":" & (x + 5)
      
      'VonBisZeilen-Bereich soll grundsätzlich ausgeblendet sein;
      'Tue das mit einem Befehl statt mit 9 Befehlen:
      .Rows(VonBisZeilen).Hidden = True
        
      For y = 5 To 33 'Step 1
      
        'Dieser VonBisZeilen-Bereich wird nur dann eingeblendet,
        'wenn in der (y).Spalte zum 1.Mal Folgendes gleichzeitig eintritt:
        '  - in der (x-1).Zeile steht das heutige Datum (bzw. ein Datum)
        '  - in der (x).  Zeile steht einer der 3 Werte "F1","F2","VER"
        
        If .Cells(x - 1, y).Value = HeuteDatum Then
          Select Case .Cells(x, y).Value
            Case "F1", "F2", "VER"
                 'Blende VonBisZeilen-Bereich ein:
                 .Rows(VonBisZeilen).Hidden = False
                 'Verlasse y-Schleife, denn mehr als eingeblendet
                 'kann der VonBisZeilen-Bereich nicht werden
                 Exit For
            Case Else
                 'Tue nichts - oder eventuell sonst etwas
          End Select
        End If
        
      Next y
      
    Next x
    
  End With
  
  Unload Schichtauswahl
  'getestet und läuft
 End Sub

Ich habe dir einigen Kommentar eingefügt, um meine Idee dahinter zu erläutern.
Ferner habe ich in diesem Vorschlag die Zelle A1 dazu verwendet, dort ein anderes Datum für die Abfrage zu verwenden anstelle des HEUTE()-Datums (=Date). Falls diese Zelle für dich ungünstig ist, müsstest du diese Zelle wo anders platzieren und natürlich den Code am Anfang von
HeuteDatum = Range("A1").Value
auf
HeuteDatum = Range("E1").Value
falls Zelle E1 günstiger wäre (... oder eben sonst eine Zelle).

Ich konnte das Makro nur grob testen, da mir deine Echtdaten fehlen. Aber ich hoffe zumindest, dass es so jetzt schneller ist.