Makro extrem langsam

Bewerten Sie hier bitte das Excel-Portal

Der kurze Weg zum Ziel: Auftragsprogrammierung

Informationen und Beispiele zum Thema MsgBox
Screenshot zu MsgBox	MsgBox-Seite mit Beispielarbeitsmappe aufrufen

Makro extrem langsam

Makro extrem langsam von MarKo vom 26.09.2019 15:23:06

AW: Makro extrem langsam - von UweD am 26.09.2019 15:47:26

AW: Makro extrem langsam - von mmat am 26.09.2019 16:49:59

AW: Makro extrem langsam - von Daniel am 26.09.2019 16:18:19

AW: Makro extrem langsam - von UweD am 26.09.2019 16:48:07

AW: Makro extrem langsam - von Piet am 26.09.2019 20:53:21

AW: Makro extrem langsam - von Daniel am 26.09.2019 21:05:18

AW: Makro extrem langsam - von snb am 26.09.2019 21:13:56

AW: Makro extrem langsam - von Piet am 26.09.2019 22:06:25

AW: Makro extrem langsam - von Policonte am 26.09.2019 23:26:30

Application.Calculation aus/ein (owT) - von EtoPHG am 27.09.2019 10:53:24

AW: Makro extrem langsam - von Daniel am 27.09.2019 12:56:48

Betrifft: Makro extrem langsam von: MarKo
Geschrieben am: 26.09.2019 15:23:06

Hallo , könnt ihr mir helfen warum dieses Makro so langsam ist ?
Besteht die Möglichkeit es zu beschleunigen ? Oder habe ich etwas falsch gemacht ?
Danke

Option Explicit

' Definition der Variablen für das Makro

Dim DSheet As Worksheet
Dim PSheet As Worksheet
Dim GSheet As Worksheet
Dim PRange As Range
Dim LastRow As Long
Dim LastColumn As Long
Dim KillSpalten As Range
Dim rngTmp As Range
Dim ArBegriffe() As Variant
Dim lz As CellFormat
Dim var As Variant
Dim introw As Integer
Dim x As Long
Dim i As Long
Dim lstrDatei As String
Dim d As Variant
Dim iWert As Integer
Dim z As Integer
Dim ende, iRow As Long
Dim wks As Worksheet
Dim lngLetzte As Long, lngI As Long
Dim rng As Range

Sub DatenLaden()


  
'Display bestätigungen ausschalten

   Application.DisplayAlerts = False

'Bildschirmaktualisierung ausschalten:

   Application.ScreenUpdating = False
   
   
 'Öffne Datei Daten

    
    Workbooks.OpenText Filename:="C:\Users\OliS\Desktop\Daten.xls", _
        Origin:=1250, StartRow:=1, DataType:=xlDelimited, TextQualifier:= _
        xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, Semicolon:=False, _
        Comma:=False, Space:=False, Other:=False, FieldInfo:=Array(Array(1, 1), _
        Array(2, 1), Array(3, 1), Array(4, 1), Array(5, 1)), TrailingMinusNumbers:=True
        

        
 ' Löscht leere Spalten

    Columns("S:S").Select
    Selection.Delete Shift:=xlToLeft
    Columns("R:R").Select
    Selection.Delete Shift:=xlToLeft
    Columns("P:P").Select
    Selection.Delete Shift:=xlToLeft
    Columns("O:O").Select
    Selection.Delete Shift:=xlToLeft
    Columns("N:N").Select
    Selection.Delete Shift:=xlToLeft
    Columns("L:L").Select
    Selection.Delete Shift:=xlToLeft
    Columns("K:K").Select
    Selection.Delete Shift:=xlToLeft
    Columns("J:J").Select
    Selection.Delete Shift:=xlToLeft
    Columns("I:I").Select
    Selection.Delete Shift:=xlToLeft
    Columns("F:F").Select
    Selection.Delete Shift:=xlToLeft
    Columns("D:D").Select
    Selection.Delete Shift:=xlToLeft
    Columns("C:C").Select
    Selection.Delete Shift:=xlToLeft
    Columns("A:A").Select
    Selection.Delete Shift:=xlToLeft
    
'Löscht Zeilen 1-5

    Rows("1:5").Select
    Selection.Delete Shift:=xlUp
    
'Löschen der Zeile, wenn Zelle in Spalte A leer ist
  
    Dim introw As Integer, intLastRow As Integer
    intLastRow = Cells.SpecialCells(xlCellTypeLastCell).Row
    For introw = intLastRow To 1 Step -1
      If Application.CountA(Rows(introw)) = 0 Then
         intLastRow = intLastRow - 1
      Else
         Exit For
      End If
    Next introw
    For introw = intLastRow To 1 Step -1
      If IsEmpty(Cells(introw, 1)) Then
         Rows(introw).Delete
      End If
    Next introw
    

'Spalten neu benennen
 
    Range("A1").Select
    ActiveCell.FormulaR1C1 = "Daten"
    Range("B1").Select
    ActiveCell.FormulaR1C1 = "Auftragsnummer"
    Range("C1").Select
    ActiveCell.FormulaR1C1 = "Datum"
    Range("D1").Select
    ActiveCell.FormulaR1C1 = "Stückzahl"
    Range("E1").Select
    ActiveCell.FormulaR1C1 = "Termin"
    Range("D1").Select
    ActiveCell.FormulaR1C1 = "Einteilung"
    

'Filter setzen größer als 90000000  Spalte C und löschen
        
   With ActiveSheet
   .Range("A1").AutoFilter Field:=3, Criteria1:= _
        "<90000000"
   .Rows(1).Hidden = True
   .UsedRange.SpecialCells(xlCellTypeVisible).Delete
   .Rows(1).Hidden = False
   .AutoFilterMode = False
   End With

'Filter setzen kleiner als 10000000 Spalte B und löschen
        
   With ActiveSheet
   .Range("A1").AutoFilter Field:=2, Criteria1:= _
        ">100000000"
   .Rows(1).Hidden = True
   .UsedRange.SpecialCells(xlCellTypeVisible).Delete
   .Rows(1).Hidden = False
   .AutoFilterMode = False
   End With
   
'Filter setzen Summe Spalte A und löschen

   With ActiveSheet
   .Range("A1").AutoFilter Field:=1, Criteria1:="Summe"
   .Rows(1).Hidden = True
   .UsedRange.SpecialCells(xlCellTypeVisible).Delete
   .Rows(1).Hidden = False
   .AutoFilterMode = False
   End With
   
'Filter setzen Woche Spalte A und löschen

   With ActiveSheet
   .Range("A1").AutoFilter Field:=1, Criteria1:="Woche"
   .Rows(1).Hidden = True
   .UsedRange.SpecialCells(xlCellTypeVisible).Delete
   .Rows(1).Hidden = False
   .AutoFilterMode = False
   End With

'Filter setzen A06 Spalte F und löschen

   With ActiveSheet
   .Range("A1").AutoFilter Field:=6, Criteria1:="A06"
   .Rows(1).Hidden = True
   .UsedRange.SpecialCells(xlCellTypeVisible).Delete
   .Rows(1).Hidden = False
   .AutoFilterMode = False
   End With
  
'Filter absteigent sotieren

   With ActiveSheet
   .Range("A1").AutoFilter Field:=6
    Range("F" & Range("F65536").End(xlUp).Row).Sort _
    Key1:=Range("F2"), Order1:=xlDescending, Header:= _
        xlGuess, OrderCustom:=1, MatchCase:=False, _
        Orientation:=xlTopToBottom, _
        DataOption1:=xlSortNormal
    .AutoFilterMode = False
   End With

'Duplicate entfernen
  
   ActiveSheet.Range("$A$1:$F$655326").RemoveDuplicates Columns:=2, Header:=xlYes
   
'Bereich zum kopieren makieren

    Range("A2").Select
    Range(Selection, Selection.End(xlDown)).Select
    Range(Selection, Selection.End(xlToRight)).Select
    
'Bereich kopieren

    Selection.Copy

'Wechsel zu Datei Auswertung

    Windows("Auswertung.xlsm").Activate
    Sheets("DatenNeu").Select
    
'Erste Freie Zeile in A finden

    Range("A1").Select
    Selection.End(xlDown).Offset(1, 0).Select
    
'Einfügen

   ActiveSheet.Paste
   
'Duplicate entfernen
   For i = Range("B65536").End(xlUp).Row To 2 Step -1
    If Application.WorksheetFunction.CountIf(Range("B:B"), Cells(i, 2)) > 1 Then Rows(i).Delete
  Next i

'Datei Daten Wachs aktivieren

    Windows("Daten.xls").Activate
    
'Mackierter Bereich aufheben

    Application.CutCopyMode = False
    
'Datei schließen ohne zu Fragen
    
    Workbooks("Daten.xls").Close savechanges:=False
    
'Gehe für nächste Abfrage auf A1
    
    Sheets("DatenNeu").Select
    Range("A1").Select
    
'Gehe zu Blatt Auswertung
 
    Sheets("Auswertung").Select
    
'Schreibe Datum der Aktualisierung

    Sheets("Auswertung").Range("B3").Value = Date & "/" & Time
    
'Tabellenblatt wechseln

    Sheets("Auswertung").Select
   
'Excelbildschrim ausblenden
  
   Application.Visible = False
    
'Anzeige MsgBox

   MsgBox "Aktualisierung erfolgreich"
   
'Bildschirmaktualisierung einschalten:
   Application.ScreenUpdating = True 
   End Sub

Betrifft: AW: Makro extrem langsam von: UweD
Geschrieben am: 26.09.2019 15:47:26

Hallo

auf select und activate kann in 99% der Fälle verzichtet werden.

Aus

    Columns("S:S").Select
    Selection.Delete Shift:=xlToLeft

wird

    Columns("S:S").Delete Shift:=xlToLeft
.
.
.
    Rows("1:5").Delete Shift:=xlUp
.
.
.
    Range("A1").FormulaR1C1 = "Daten"

usw.

Den Rest würde ich mir ansehen, wenn du eine Musterdatei hochlädst.

LG UweD

Betrifft: AW: Makro extrem langsam von: mmat
Geschrieben am: 26.09.2019 16:49:59

Hallo,

was Uwe schrieb ist alles richtig, dürfte aber kaum das Makro beschleunigen.

Dagegen könnte ein Zusamenfassen des Löschens mehrerer nebeneinderliegender Spalten schon einen kleinen Effekt haben. Aus

  Columns("P:P").Select
    Selection.Delete Shift:=xlToLeft
    Columns("O:O").Select
    Selection.Delete Shift:=xlToLeft
    Columns("N:N").Select
    Selection.Delete Shift:=xlToLeft

wird dann

Columns("N:P").Delete Shift:=xlToLeft

Aber sowas ist eigentlich nur Kosmetik, das Problem ist im Vorgehen insgesamt begründet. Du liest eine grosse Datei in ein Tabellenblatt ein (Wieviele Zeilen / Spalten hat die ???) und fängst dann an im großen Stil nicht benötigte Daten im Tabellenblatt zu löschen (Wieviele Zeilen / Spalten bleiben denn übrig ?????). Das kostet viel Zeit.

Der Trick ist (wahrscheinlich), die nicht benötigten Daten garnicht erst zu lesen sondern beim Einlesen zu überspringen. Das erfordert eine vollkommen andere Programmierung und ist ohne Musterdaten nicht realisierbar.

vg, MM

Betrifft: AW: Makro extrem langsam von: Daniel
Geschrieben am: 26.09.2019 16:18:19

HI
weitere Optimierungen:
1. beim Löschen der Spalte nicht jede Spalte einzeln löschen, sondern alle im Block:

Range("A:A,C:D,F:F,...,R:S").Delete

2. die Zeilen mit leerer Zelle in Spalte A ebenfalls über den Autofilter ermitteln und so im Block löschen und nicht per Schleife jede Zeile einzeln

3. beim Löschen von Zeilen per Autofilter die Tabelle vorher nach der Filterspalte sortieren, so dass die zu löschenden Zeilen möglichst direkt untereinander stehen.

Gruß Daniel

Betrifft: AW: Makro extrem langsam von: UweD
Geschrieben am: 26.09.2019 16:48:07

Union(Columns("S:R"), Columns("P:N"), Columns("L:I"), Columns("F:F"), Columns("D:C"), Columns(" _
A:A")).Delete Shift:=xlToLeft

    Range("A1:F1") = Split("Daten; Auftragsnummer; Datum; Stückzahl; Termin; Einteilung", "; ")

Betrifft: AW: Makro extrem langsam von: Piet
Geschrieben am: 26.09.2019 20:53:21

Hallo marko

ich hab mir den Code auch mal angesehen und bereinigt. Konnte aber nicht prüfen ob er korrekt lauft!
Alle Select habe ich soweit es geht herausgenommen, die Spalten zum löschen zusammengefasst.
Ich bitte dich aber höflich den unteren Code zur Sicherheit in einer Kopie zu testen, nicht im Original.

Beim bereinigen ist mir ein Fehler aufgefallen, und zwar hier. Da stimmt die Endzeile nicht:
'Duplicate entfernen
'**** $F$655326 Zeile stimmt nicht!! 65536 ist LastZell bei Excel 2003!
ActiveSheet.Range("$A$1:$F$655326").RemoveDuplicates Columns:=2, Header:=xlYes

Die anderen Verbesserungen wie Rang zusammenfassen von Daniel oder Union musst du selbst einbauen!
PS - du hast oben DisplayAlert ausgeschaltet, aber vergessen es vor End Sub wieder einzuschalten.
Wenn Application.ScreenUpdating = True am Ende fehlt stört das nicht, der Bildschirm schaltet sich automatisch ein.

Würde mich freuen wenn der bereinigte Code schneller laeuft.

mfg Piet

Sub DatenLaden()
      
    'Display bestätigungen ausschalten
    
       Application.DisplayAlerts = False
    
    'Bildschirmaktualisierung ausschalten:
    
       Application.ScreenUpdating = False
       
     'Öffne Datei Daten
        
        Workbooks.OpenText Filename:="C:\Users\OliS\Desktop\Daten.xls", _
            Origin:=1250, StartRow:=1, DataType:=xlDelimited, TextQualifier:= _
            xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, Semicolon:=False, _
            Comma:=False, Space:=False, Other:=False, FieldInfo:=Array(Array(1, 1), _
            Array(2, 1), Array(3, 1), Array(4, 1), Array(5, 1)), TrailingMinusNumbers:=True
            
     ' Löscht leere Spalten
    
        Columns("R:S").Delete Shift:=xlToLeft
        Columns("N:P").Delete Shift:=xlToLeft
        Columns("I:L").Delete Shift:=xlToLeft
        Columns("F:F").Delete Shift:=xlToLeft
        Columns("C:D").Delete Shift:=xlToLeft
        Columns("A:A").Delete Shift:=xlToLeft
        
    'Löscht Zeilen 1-5
    
        Rows("1:5").Delete Shift:=xlUp
        
    'Löschen der Zeile, wenn Zelle in Spalte A leer ist
      
        Dim introw As Integer, intLastRow As Integer
        intLastRow = Cells.SpecialCells(xlCellTypeLastCell).Row
        For introw = intLastRow To 1 Step -1
          If Application.CountA(Rows(introw)) = 0 Then
             intLastRow = intLastRow - 1
          Else
             Exit For
          End If
        Next introw
        For introw = intLastRow To 1 Step -1
          If IsEmpty(Cells(introw, 1)) Then
             Rows(introw).Delete
          End If
        Next introw
        
    
    'Spalten neu benennen
     
        Range("A1").Value = "Daten"
        Range("B1").Value = "Auftragsnummer"
        Range("C1").Value = "Datum"
        Range("D1").Value = "Stückzahl"
        Range("E1").Value = "Termin"
        Range("D1").Value = "Einteilung"
     
    'Filter setzen größer als 90000000  Spalte C und löschen
            
       With ActiveSheet
       .Range("A1").AutoFilter Field:=3, Criteria1:="<90000000"
       .Rows(1).Hidden = True
       .UsedRange.SpecialCells(xlCellTypeVisible).Delete
       .Rows(1).Hidden = False
       .AutoFilterMode = False
       End With
    
    'Filter setzen kleiner als 10000000 Spalte B und löschen
            
       With ActiveSheet
       .Range("A1").AutoFilter Field:=2, Criteria1:=">100000000"
       .Rows(1).Hidden = True
       .UsedRange.SpecialCells(xlCellTypeVisible).Delete
       .Rows(1).Hidden = False
       .AutoFilterMode = False
       End With
       
    'Filter setzen Summe Spalte A und löschen
    
       With ActiveSheet
       .Range("A1").AutoFilter Field:=1, Criteria1:="Summe"
       .Rows(1).Hidden = True
       .UsedRange.SpecialCells(xlCellTypeVisible).Delete
       .Rows(1).Hidden = False
       .AutoFilterMode = False
       End With
       
    'Filter setzen Woche Spalte A und löschen
    
       With ActiveSheet
       .Range("A1").AutoFilter Field:=1, Criteria1:="Woche"
       .Rows(1).Hidden = True
       .UsedRange.SpecialCells(xlCellTypeVisible).Delete
       .Rows(1).Hidden = False
       .AutoFilterMode = False
       End With
    
    'Filter setzen A06 Spalte F und löschen
    
       With ActiveSheet
       .Range("A1").AutoFilter Field:=6, Criteria1:="A06"
       .Rows(1).Hidden = True
       .UsedRange.SpecialCells(xlCellTypeVisible).Delete
       .Rows(1).Hidden = False
       .AutoFilterMode = False
       End With
      
    'Filter absteigent sotieren
    
       With ActiveSheet
       .Range("A1").AutoFilter Field:=6
        Range("F" & Range("F65536").End(xlUp).Row).Sort _
        Key1:=Range("F2"), Order1:=xlDescending, Header:= _
            xlGuess, OrderCustom:=1, MatchCase:=False, _
            Orientation:=xlTopToBottom, _
            DataOption1:=xlSortNormal
        .AutoFilterMode = False
       End With
    
    'Duplicate entfernen
    '****  $F$655326   Zeile stimmt nicht!!  65536 ist LastZell bei Excel 2003!
       ActiveSheet.Range("$A$1:$F$655326").RemoveDuplicates Columns:=2, Header:=xlYes
       
    'Wechsel zu Datei Auswertung
        Set asw = Windows("Auswertung.xlsm").Sheets("DatenNeu")
       
       'Bereich direkt kopieren
    
        Range("A2").End(xlDown).End(xlToRight).Copy
        
       'Erste Freie Zeile in A finden
    
        asw.Range("A1").End(xlDown).Offset(1, 0).PasteSpecial xlPasteAll
        Application.CutCopyMode = False
       
    'Duplicate entfernen
       For i = Range("B65536").End(xlUp).Row To 2 Step -1
        If Application.WorksheetFunction.CountIf(Range("B:B"), Cells(i, 2)) > 1 Then Rows(i). _
Delete
      Next i
    
    'Datei Daten Wachs aktivieren
    
        Windows("Daten.xls").Activate
        
    'Datei schließen ohne zu Fragen
        
        Workbooks("Daten.xls").Close savechanges:=False
        
    'Gehe für nächste Abfrage auf A1
        
        Sheets("DatenNeu").Select
        Range("A1").Select
        
    'Gehe zu Blatt Auswertung
     
        Sheets("Auswertung").Select
        
    'Schreibe Datum der Aktualisierung
    
        Sheets("Auswertung").Range("B3").Value = Date & "/" & Time
        
    'Tabellenblatt wechseln
    
        Sheets("Auswertung").Select
       
    'Excelbildschrim ausblenden
      
       Application.Visible = False
        
    'Anzeige MsgBox
    
       MsgBox "Aktualisierung erfolgreich"
       
    'Bildschirmaktualisierung einschalten:
       Application.ScreenUpdating = True
    
    'Display bestätigungen einschalten
       Application.DisplayAlerts = True
       End Sub

Betrifft: AW: Makro extrem langsam von: Daniel
Geschrieben am: 26.09.2019 21:05:18

HI
DisplayAlerts wird meines Wissens nach auch wieder automatisch eingeschaltet.
nur Caluculation und EnableEvents bleiben bei Makroende auf dem zuletzt eigeschalteten Wert.
Macht auch Sinn, weil diese Eigenschaften der Anwender auch im normalen Excel über die Menüfunktionen ein- und ausschalten kann, während es für ScreenUpdating und DisplayAlerts es normalbetrieb nur eine sinnvolle Einstellung gibt.
Gruß Daniel
ps: ok, das EnableEvents kann man auch nicht über das Menü steuern, aber über den Button "Entwurfsmodus" kann man ebenfalls die automatische Ausführung der Events ein- und ausschalten und somit gleiches bewirken.

Betrifft: AW: Makro extrem langsam von: snb
Geschrieben am: 26.09.2019 21:13:56

@Pet

Statt

Range("A1").Value = "Daten"
Range("B1").Value = "Auftragsnummer"
Range("C1").Value = "Datum"
Range("D1").Value = "Stückzahl"
Range("E1").Value = "Termin"
Range("F1").Value = "Einteilung"

Verwende

Range("A1:F1")=split("Daten Aufragsnummer Datm Stückzahl Termin Einteilung")

Betrifft: AW: Makro extrem langsam von: Piet
Geschrieben am: 26.09.2019 22:06:25

Hallo snb

vielen Dank für den Hinweis, man lernt immer noch was dazu. Bin gespannt was der Frager dazu sagt.
Ob sein Code jetzt besser laeuft? Warte gespannt seine Rückmeldung ab. - Herzlich Grüsse aus Ankara.

mfg Piet

Betrifft: AW: Makro extrem langsam von: Policonte
Geschrieben am: 26.09.2019 23:26:30

Perfekt , ich danke euch .
Ist zwar nich nicht perfekt aber wesentlich schneller .
Denke es liegt an der großen Datenmenge das es so langsam ist .

Betrifft: Application.Calculation aus/ein (owT) von: EtoPHG
Geschrieben am: 27.09.2019 10:53:24

Betrifft: AW: Makro extrem langsam von: Daniel
Geschrieben am: 27.09.2019 12:56:48

Hi
im Prinzip sollte sich der Code so zusammenfassen lassen und damit auch deutlich schneller sein:

Sub DatenLaden()
Application.ScreenUpdating = True

  'Öffne Datei Daten
     Workbooks.OpenText Filename:="C:\Users\OliS\Desktop\Daten.xls", _
         Origin:=1250, StartRow:=5, DataType:=xlDelimited, TextQualifier:= _
         xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, Semicolon:=False, _
         Comma:=False, Space:=False, Other:=False, FieldInfo:=Array(Array(1, 1), _
         Array(2, 1), Array(3, 1), Array(4, 1), Array(5, 1)), TrailingMinusNumbers:=True
         
' Löscht leere Spalten
 
     Columns("A:A,C:D,F:F,I:L,N:P,R:S").Delete Shift:=xlToLeft
     
 'Löscht Zeilen 1-5: 'in OpenText integriert
 
 'Spalten neu benennen
 Range("A1:E1").Value = Array("Daten", "Auftragsnummer", "Datum", "Stückzahl", "Termin")
     
 'Löschen von Zeilen mit Bed
 'Löschen der Zeile, wenn Zelle in Spalte A leer istingung (alle)
 'Filter setzen größer als 90000000  Spalte C und löschen4
 'Filter setzen kleiner als 10000000 Spalte B und löschen
 'Filter setzen Summe Spalte A und löschen
 'Filter setzen Woche Spalte A und löschen
   With ActiveSheet.UsedRange
       With .Columns(Columns.Count + 1)
           .FormulaR1C1 = _
 "=IF(OR(RC1="""",RC1=""Summe"",RC1=""Woche"",RC3<90000000,RC2>100000000,RC6=""A06""),0,Row())"
           .Cells(1, 1).Value = 0
           .EntireRow.RemoveDuplicates Columns:=.Column, Header:=xlNo
           .ClearContents
       End With
   End With
   
'Duplicate entfernen
   
    ActiveSheet.Range("A:F").RemoveDuplicates Columns:=2, Header:=xlYes
 
 'Sortieren
 Range("A:F").Sort Key1:=Range("F2"), order1:=xlDescending, Header:=ye
 
 'Bereich zum kopieren und einfügen
 
     Range("A2").CurrentRegion.Offset(1, 0).Copy
     With Workbooks("Auswertung.xlsm").Sheets("DatenNeu")
       .Cells(.Rows.Count, 1).End(xlUp).Offset(1, 0).PasteSpecial xlPasteAll
       Application.CutCopyMode = False
       .UsedRange.RemoveDuplicates Columns:=2, Header:=xlYes
   End With
    
Workbooks("Daten.xls").Close savechanges:=False
     

     
 'Schreibe Datum der Aktualisierung
 
     Sheets("Auswertung").Range("B3").Value = Date & "/" & Time
     
 'Tabellenblatt wechseln
 
     Sheets("Auswertung").Select
    
 'Excelbildschrim ausblenden
   
    Application.Visible = False
     
 'Anzeige MsgBox
 
    MsgBox "Aktualisierung erfolgreich"
    
    End Sub

Gruß Daniel

Beiträge aus dem Excel-Forum zum Thema "Makro extrem langsam"

Diagramm-Datenreihen blinken lassen und Linie langsam zeichnen

Herbers Excel/VBA-Archiv

Der kurze Weg zum Ziel: Auftragsprogrammierung

Makro extrem langsam

Beiträge aus dem Excel-Forum zum Thema "Makro extrem langsam"