Makro Laufzeit aufeinmal sehr langsam

Hallo,
mein Makro iteriert bis ein bestimmter Wert erreicht wurde. Dies ging sehr schnell bis vor kurzem. Jedoch habe ich nun eine Userform eingefügt und es läuft erheblich langsamer. Liegt das an der Userform oder einfach an Excel? Auch wenn der Iterationsschritt nur 0.01 ist, gestern lief das noch sehr schnell...

Sub Tabelle1()
Dim UntereVolumenstromGrenze1 As Double 'Min V
Dim ObereVolumenstromGrenze1 As Double 'Max V
Dim x As String
Dim y As String
Dim z As String
Dim K1_xF As String
x = "K1-1F"
y = "K1-2F"
z = "K1-3F"
Application.StatusBar = True
Application.StatusBar = "Please wait..."
UntereVolumenstromGrenze1 = Range("N5").Value 'Obere Volumenstromgrenze der Pumpe
ObereVolumenstromGrenze1 = Range("N6").Value 'Untere Volumenstromgrenze der Pumpe
If Range("C2").Value = x And Range("N6").Value = 11 Then 
    Range("F22").Value = Range("F21").Value
    
    Do Until Range("N22").Value = 0.1 And Range("N22").Value >= 0
        
      Range("F22").Value = Range("F22").Value + 0.01
   
    Loop
    
ElseIf Range("C2").Value = y And Range("N6").Value = 11 Then
        Range("F22").Value = Range("F21").Value
      Do Until Range("N22").Value = 0.1 And Range("N22").Value >= 0
           Range("F22").Value = Range("F22").Value + 0.01
      Loop
ElseIf Range("C2").Value = z And Range("N6").Value = 11 Then
      Range("F22").Value = Range("F21").Value
      Do Until Range("N22").Value = 0.1 And Range("N22").Value >= 0
         Range("F22").Value = Range("F22").Value + 0.01
      Loop
Else
Range("F22").Value = Range("F21").Value
Do Until Range("N22").Value = 0.1 And Range("N22").Value >= 0   
  Range("F22").Value = Range("F22").Value + 0.1 
Loop
If Range("F22").Value > Range("N6").Value Then
Range("F22").Value = Range("N6").Value
End If
 End If
 
MsgBox "Completed!"
 
Application.StatusBar = False
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address(0, 0) = "B5" Then
    If Target.Value = "Manuelle Eingabe" Then
        UserForm1.Show
    End If
End If
End Sub

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Sub Tabelle1() Dim UntereVolumenstromGrenze1 As Double 'Min V Dim ObereVolumenstromGrenze1 As Double 'Max V Dim K1_xF As String Const x = "K1-1F" Const y = "K1-2F" Const z = "K1-3F" With Application .StatusBar = "Please wait..." .EnableEvents = False .ScreenUpdating = False End With UntereVolumenstromGrenze1 = Range("N5").Value 'Obere Volumenstromgrenze der Pumpe ObereVolumenstromGrenze1 = Range("N6").Value 'Untere Volumenstromgrenze der Pumpe If Range("N6").Value = 11 Then On Error GoTo ERREXIT Select Case Range("C2") Case x, y, z Range("F22").Value = Range("F21").Value Do Until Range("N22").Value = 0.1 And Range("N22").Value >= 0.1 Range("F22").Value = Range("F22").Value + 0.01 Loop Case Else Range("F22").Value = Range("F21").Value Do Until Range("N22").Value = 0.1 And Range("N22").Value >= 0 Range("F22").Value = Range("F22").Value + 0.1 Loop If Range("F22").Value > Range("N6").Value Then Range("F22").Value = Range("N6").Value End If End Select End If MsgBox "Completed!" ERREXIT: With Application .StatusBar = False .EnableEvents = True End With End Sub

das Problem ist nicht die Userform, sondern dein Change-Event-Makro
dieses wird jedes mal ausgeführt, wenn du ein Range(...).Value = ... durchführst und das kostet Zeit, zumal du das sehr oft machst.
Möglichkeit 1: du deaktivierst die automatische Ausführung der Eventmakros während der Laufzeit des Makros:

Sub Tabelle1()
... Variablendeklaration
Application.EnableEvents = False
...
... hier der Code
...
Application.EnableEvents = True
End Sub

Beachte, dass bei einem Fehlerabbruch die Events ausgeschaltet sind und auch bleiben.
Dh du musst diese durch Eingabe von Application.EnableEvents = True im Direktfenster diese wieder einschalten
andere Möglichkeit:
du verzichtest auf das Change-Event und startest die Userform im Makro Tabelle1, wenn der Anwender "manuelle Eingabe" ausgewählt hat.

Sub Tabelle1()
if Range("B5") = "Manuelle Eingabe" then Userform1.show
...
end Sub

allerdings funktioniert das nicht in allen möglichen Anwendungsfällen, du müsstest prüfen, ob das bei dir so geht.
Gruß Daniel

Sub Tabelle1() Dim UntereVolumenstromGrenze1 As Double 'Min V Dim ObereVolumenstromGrenze1 As Double 'Max V Dim x As String Dim y As String Dim z As String Dim K1_xF As String Application.EnableEvents = False x = "K1-1F" y = "K1-2F" z = "K1-3F" Application.StatusBar = True Application.StatusBar = "Please wait..." UntereVolumenstromGrenze1 = Range("N5").Value 'Obere Volumenstromgrenze der Pumpe ObereVolumenstromGrenze1 = Range("N6").Value 'Untere Volumenstromgrenze der Pumpe If Range("C2").Value = x And Range("N6").Value = 11 Then Range("F22").Value = Range("F21").Value Do Until Range("N22").Value = 0.1 And Range("N22").Value >= 0 Range("F22").Value = Range("F22").Value + 0.01 Loop ElseIf Range("C2").Value = y And Range("N6").Value = 11 Then Range("F22").Value = Range("F21").Value Do Until Range("N22").Value = 0.1 Range("F22").Value = Range("F22").Value + 0.01 Loop ElseIf Range("C2").Value = z And Range("N6").Value = 11 Then Range("F22").Value = Range("F21").Value Do Until Range("N22").Value = 0.1 Range("F22").Value = Range("F22").Value + 0.01 Loop Else Range("F22").Value = Range("F21").Value Do Until Range("N22").Value = 0.1 Range("F22").Value = Range("F22").Value + 0.1 Loop If Range("F22").Value > Range("N6").Value Then Range("F22").Value = Range("N6").Value End If End If MsgBox "Completed!" Application.StatusBar = False Application.EnableEvents = True End Sub

Sub Tabelle1() Application.EnableEvents = False Range("F22").Value = Range("F21").Value If Range("N6").Value = 11 Then Select Case Range("C2").Value Case "K1-1F" Do Until Range("N22").Value >= 0 And Range("N22").Value = 0.1 Range("F22").Value = Range("F22").Value + 0.01 Loop Case "K1-2F", "K1-3F" Do Until Range("N22").Value = 0.1 Range("F22").Value = Range("F22").Value + 0.01 Loop End Select Else Do Until Range("N22").Value = 0.1 Range("F22").Value = Range("F22").Value + 0.1 Loop If Range("F22").Value > Range("N6").Value Then Range("F22").Value = Range("N6").Value End If End If MsgBox "Completed!" Application.EnableEvents = True End Sub

Beliebteste Forumthreads (12 Monate)

Makro Laufzeit aufeinmal sehr langsam

10
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

Makro Laufzeit aufeinmal sehr langsam

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

VBA Beispiele zu verwandten Themen

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

10
Beiträge zum Forumthread

Beiträge zu diesem Forumthread