Office: (Office 2016) Flackern bei Makro abstellen und Abfrage evtl ändern

Helfe beim Thema Flackern bei Makro abstellen und Abfrage evtl ändern in Microsoft Excel Hilfe um das Problem gemeinsam zu lösen; Hallo zusammen, beim ausführen des Makros flackert der Bildschirm unheimlich. Habt Ihr ne Idee wie ich das abstellen kann? Screen.Updating = false... Dieses Thema im Forum "Microsoft Excel Hilfe" wurde erstellt von Marcel1002, 21. Januar 2019.

  1. Flackern bei Makro abstellen und Abfrage evtl ändern


    Hallo zusammen,

    beim ausführen des Makros flackert der Bildschirm unheimlich. Habt Ihr ne Idee wie ich das abstellen kann? Screen.Updating = false hab ich bereits eingefügt.
    Ein weiterer Wunsch wäre die Datums bzw. Schichtabfrage (hab ich mit zwei Inputboxen gelöst) per Dropdownmenü und evtl. einer Userform zu gestalten.
    Allerdings hab ich mit Userfrom noch nicht gearbeitet.
    Das Makro wird von einem Touchbildschirm aus ausgeführt, daher wäre die Bedienbarkeit besser.

    Bin für jede Hilfe dankbar;-)

    Grüße

    Anbei der Code:
    HTML:
    Sub Datenübernahme()
    
    ActiveSheet.Unprotect ("MHS")
    Application.DisplayAlerts = False
    With Application
      .ScreenUpdating = False
      .Calculation = xlCalculationManual
    End With
    
    Workbooks.Open Filename:="\\HECSOFILER01\Global-Data\MCO-Produktion\Schichteinteilung\Schichteinteilung.xlsm", Password:="2019", ReadOnly:=True
        
        
        Dim WKS As Worksheet
         Dim strWks As String
         strWks = InputBox("Team A, B, C, D oder E angeben:", , "A")
         
         If strWks <> "" Then
             On Error Resume Next
             Err.Clear
             Set WKS = Worksheets(strWks)
             If Err.Number > 0 Then
                 Beep
                 MsgBox "Team nicht gefunden! Eingabe richtig?"
             Else
                 WKS.Select
                 Set WKS = Nothing
             End If
         End If
       
           
         Dim rngFind As Range
     Dim strDate As String
     strDate = Format(Date, "YYYY-MM-DD")
    
     strDate = InputBox("Datum:", , strDate)
     If strDate = "" Then Exit Sub
      
     Set rngFind = Cells.Find(DateValue(strDate), LookIn:=xlValues, LookAt:=xlWhole)
    
       If Not rngFind Is Nothing Then
           
         Range("A2").Select
         Selection.Copy
         ThisWorkbook.ActiveSheet.Cells(4, 5).PasteSpecial Paste:=xlPasteValues
             
         rngFind.Activate
         rngFind.Offset(0, 0).Copy
         ThisWorkbook.ActiveSheet.Cells(2, 5).PasteSpecial Paste:=xlPasteValues
            
         rngFind.Activate
         rngFind.Offset(0, 2).Copy
         ThisWorkbook.ActiveSheet.Cells(6, 2).PasteSpecial Paste:=xlPasteValues
          
         rngFind.Activate
         rngFind.Offset(0, 3).Copy
         ThisWorkbook.ActiveSheet.Cells(6, 4).PasteSpecial Paste:=xlPasteValues
          
         rngFind.Activate
         rngFind.Offset(0, 4).Copy
         ThisWorkbook.ActiveSheet.Cells(9, 2).PasteSpecial Paste:=xlPasteValues
          
         rngFind.Activate
         rngFind.Offset(0, 5).Copy
         ThisWorkbook.ActiveSheet.Cells(10, 2).PasteSpecial Paste:=xlPasteValues
          
         rngFind.Activate
         rngFind.Offset(0, 6).Copy
         ThisWorkbook.ActiveSheet.Cells(11, 2).PasteSpecial Paste:=xlPasteValues
          
          rngFind.Activate
         rngFind.Offset(0, 7).Copy
         ThisWorkbook.ActiveSheet.Cells(9, 3).PasteSpecial Paste:=xlPasteValues
          
          rngFind.Activate
         rngFind.Offset(0, 8).Copy
         ThisWorkbook.ActiveSheet.Cells(10, 3).PasteSpecial Paste:=xlPasteValues
          
          rngFind.Activate
         rngFind.Offset(0, 9).Copy
         ThisWorkbook.ActiveSheet.Cells(11, 3).PasteSpecial Paste:=xlPasteValues
          
             rngFind.Activate
         rngFind.Offset(0, 10).Copy
         ThisWorkbook.ActiveSheet.Cells(9, 4).PasteSpecial Paste:=xlPasteValues
          
          rngFind.Activate
         rngFind.Offset(0, 11).Copy
         ThisWorkbook.ActiveSheet.Cells(10, 4).PasteSpecial Paste:=xlPasteValues
          
          rngFind.Activate
         rngFind.Offset(0, 12).Copy
         ThisWorkbook.ActiveSheet.Cells(11, 4).PasteSpecial Paste:=xlPasteValues
          
           rngFind.Activate
         rngFind.Offset(0, 13).Copy
         ThisWorkbook.ActiveSheet.Cells(9, 5).PasteSpecial Paste:=xlPasteValues
          
             rngFind.Activate
         rngFind.Offset(0, 14).Copy
         ThisWorkbook.ActiveSheet.Cells(10, 5).PasteSpecial Paste:=xlPasteValues
          
          rngFind.Activate
         rngFind.Offset(0, 15).Copy
         ThisWorkbook.ActiveSheet.Cells(11, 5).PasteSpecial Paste:=xlPasteValues
           
              
       Else
         MsgBox "Das Datum wurde nicht gefunden!"
       End If
       
    
    Application.CutCopyMode = False
    
    Workbooks("Schichteinteilung.xlsm").Close SaveChanges:=False
             
    ActiveSheet.Protect ("MHS"), DrawingObjects:=True, Contents:=True, Scenarios:=True
    
    With Application
      .ScreenUpdating = True
      .Calculation = xlCalculationAutomatic
    End With
    
    ThisWorkbook.Saved = True
    Application.DisplayAlerts = True
    End Sub
    
     
    Marcel1002, 21. Januar 2019
    #1
  2. Beverly
    Beverly Erfahrener User
    Hi,

    das Flackern ist auch logisch, da du die Zellen jeweils erst selektierst/aktivierst ehe der Code etwas macht. Ersetze an allen Stellen die folgenden (jeweils relevanten) Zeilen

    Code:
         Range("A2").Select
         Selection.Copy

    durch diese Zeile

    Code:
         Range("A2").Copy

    bzw.

    Code:
         rngFind.Activate
         rngFind.Offset(0, 0).Copy

    durch

    Code:
         rngFind.Offset(0, 0).Copy
    usw.


    Bis später,
    Karin
     
    Beverly, 21. Januar 2019
    #2
  3. Danke für die Hilfe bzw. das Feedback. Ich hab den Code angepasst.
    Allerdings ist das Flackern unverändert.

    Gibt's noch ne andere Idee??

    Geänderter Code:

    HTML:
    Sub Datenübernahme()
    
    ActiveSheet.Unprotect ("MHS")
    Application.DisplayAlerts = False
    With Application
      .ScreenUpdating = False
      .Calculation = xlCalculationManual
    End With
    
    Workbooks.Open Filename:="\\HECSOFILER01\Global-Data\MCO-Produktion\Schichteinteilung\Schichteinteilung.xlsm", Password:="2019", ReadOnly:=True
        
        
        Dim WKS As Worksheet
         Dim strWks As String
         strWks = InputBox("Team A, B, C, D oder E angeben:", , "A")
         
         If strWks <> "" Then
             On Error Resume Next
             Err.Clear
             Set WKS = Worksheets(strWks)
             If Err.Number > 0 Then
                 Beep
                 MsgBox "Team nicht gefunden! Eingabe richtig?"
             Else
                 WKS.Select
                 Set WKS = Nothing
             End If
         End If
       
           
         Dim rngFind As Range
     Dim strDate As String
     strDate = Format(Date, "YYYY-MM-DD")
    
     strDate = InputBox("Datum:", , strDate)
     If strDate = "" Then Exit Sub
      
     Set rngFind = Cells.Find(DateValue(strDate), LookIn:=xlValues, LookAt:=xlWhole)
    
       If Not rngFind Is Nothing Then
           
         Range("A2").Copy
         
         ThisWorkbook.ActiveSheet.Cells(4, 5).PasteSpecial Paste:=xlPasteValues
             
         
         rngFind.Offset(0, 0).Copy
         ThisWorkbook.ActiveSheet.Cells(2, 5).PasteSpecial Paste:=xlPasteValues
            
         
         rngFind.Offset(0, 2).Copy
         ThisWorkbook.ActiveSheet.Cells(6, 2).PasteSpecial Paste:=xlPasteValues
          
         
         rngFind.Offset(0, 3).Copy
         ThisWorkbook.ActiveSheet.Cells(6, 4).PasteSpecial Paste:=xlPasteValues
          
         
         rngFind.Offset(0, 4).Copy
         ThisWorkbook.ActiveSheet.Cells(9, 2).PasteSpecial Paste:=xlPasteValues
          
         
         rngFind.Offset(0, 5).Copy
         ThisWorkbook.ActiveSheet.Cells(10, 2).PasteSpecial Paste:=xlPasteValues
          
         
         rngFind.Offset(0, 6).Copy
         ThisWorkbook.ActiveSheet.Cells(11, 2).PasteSpecial Paste:=xlPasteValues
          
          
         rngFind.Offset(0, 7).Copy
         ThisWorkbook.ActiveSheet.Cells(9, 3).PasteSpecial Paste:=xlPasteValues
          
          
         rngFind.Offset(0, 8).Copy
         ThisWorkbook.ActiveSheet.Cells(10, 3).PasteSpecial Paste:=xlPasteValues
          
          
         rngFind.Offset(0, 9).Copy
         ThisWorkbook.ActiveSheet.Cells(11, 3).PasteSpecial Paste:=xlPasteValues
          
             
         rngFind.Offset(0, 10).Copy
         ThisWorkbook.ActiveSheet.Cells(9, 4).PasteSpecial Paste:=xlPasteValues
          
          
         rngFind.Offset(0, 11).Copy
         ThisWorkbook.ActiveSheet.Cells(10, 4).PasteSpecial Paste:=xlPasteValues
          
          
         rngFind.Offset(0, 12).Copy
         ThisWorkbook.ActiveSheet.Cells(11, 4).PasteSpecial Paste:=xlPasteValues
          
           
         rngFind.Offset(0, 13).Copy
         ThisWorkbook.ActiveSheet.Cells(9, 5).PasteSpecial Paste:=xlPasteValues
          
             
         rngFind.Offset(0, 14).Copy
         ThisWorkbook.ActiveSheet.Cells(10, 5).PasteSpecial Paste:=xlPasteValues
          
          
         rngFind.Offset(0, 15).Copy
         ThisWorkbook.ActiveSheet.Cells(11, 5).PasteSpecial Paste:=xlPasteValues
           
              
       Else
         MsgBox "Das Datum wurde nicht gefunden!"
       End If
       
    
    Application.CutCopyMode = False
    
    Workbooks("Schichteinteilung.xlsm").Close SaveChanges:=False
             
    ActiveSheet.Protect ("MHS"), DrawingObjects:=True, Contents:=True, Scenarios:=True
    
    With Application
      .ScreenUpdating = True
      .Calculation = xlCalculationAutomatic
    End With
    
    ThisWorkbook.Saved = True
    Application.DisplayAlerts = True
    End Sub
    
    
    
     
    Marcel1002, 21. Januar 2019
    #3
  4. Beverly
    Beverly Erfahrener User

    Flackern bei Makro abstellen und Abfrage evtl ändern

    Du hast noch eine unnötige Zeile mit Select:

    Code:
    WKS.Select
    Lasse den Else-Zweig komplett weg und beziehe dich im weiteren Code auf die Variable WKS - nach diesem Prinzip:

    Code:
     With WKS
         Set rngFind = .Cells.Find(DateValue(strDate), LookIn:=xlValues, LookAt:=xlWhole)
        
           If Not rngFind Is Nothing Then
               
             .Range("A2").Copy
             
             '.... hier der restliche Code
    End With
    
    

    Bis später,
    Karin
     
    Beverly, 21. Januar 2019
    #4
  5. Danke aber ich fürchte da kann ich dir noch nicht ganz folgen... Bin nicht der Oberchecker

    Laufen tut der Code so, aber flackern leider auch ;-)
    Passt der Code so?


    HTML:
    Sub Datenübernahme()
    
    ActiveSheet.Unprotect ("MHS")
    Application.DisplayAlerts = False
    With Application
      .ScreenUpdating = False
      .Calculation = xlCalculationManual
    End With
    
    Workbooks.Open Filename:="\\HECSOFILER01\Global-Data\MCO-Produktion\Schichteinteilung\Schichteinteilung.xlsm", Password:="2019", ReadOnly:=True
        
        
        Dim WKS As Worksheet
         Dim strWks As String
         strWks = InputBox("Team A, B, C, D oder E angeben:", , "A")
         
         If strWks <> "" Then
             On Error Resume Next
             Err.Clear
             Set WKS = Worksheets(strWks)
             If Err.Number > 0 Then
                 Beep
                 MsgBox "Team nicht gefunden! Eingabe richtig?"
             Else
             
              
       
           
         Dim rngFind As Range
     Dim strDate As String
     strDate = Format(Date, "YYYY-MM-DD")
    
     strDate = InputBox("Datum:", , strDate)
     If strDate = "" Then Exit Sub
      
     With WKS
         Set rngFind = .Cells.Find(DateValue(strDate), LookIn:=xlValues, LookAt:=xlWhole)
    
       If Not rngFind Is Nothing Then
           
         Range("A2").Copy
         
         ThisWorkbook.ActiveSheet.Cells(4, 5).PasteSpecial Paste:=xlPasteValues
             
         
         rngFind.Offset(0, 0).Copy
         ThisWorkbook.ActiveSheet.Cells(2, 5).PasteSpecial Paste:=xlPasteValues
            
         
         rngFind.Offset(0, 2).Copy
         ThisWorkbook.ActiveSheet.Cells(6, 2).PasteSpecial Paste:=xlPasteValues
          
         
         rngFind.Offset(0, 3).Copy
         ThisWorkbook.ActiveSheet.Cells(6, 4).PasteSpecial Paste:=xlPasteValues
          
         
         rngFind.Offset(0, 4).Copy
         ThisWorkbook.ActiveSheet.Cells(9, 2).PasteSpecial Paste:=xlPasteValues
          
         
         rngFind.Offset(0, 5).Copy
         ThisWorkbook.ActiveSheet.Cells(10, 2).PasteSpecial Paste:=xlPasteValues
          
         
         rngFind.Offset(0, 6).Copy
         ThisWorkbook.ActiveSheet.Cells(11, 2).PasteSpecial Paste:=xlPasteValues
          
          
         rngFind.Offset(0, 7).Copy
         ThisWorkbook.ActiveSheet.Cells(9, 3).PasteSpecial Paste:=xlPasteValues
          
          
         rngFind.Offset(0, 8).Copy
         ThisWorkbook.ActiveSheet.Cells(10, 3).PasteSpecial Paste:=xlPasteValues
          
          
         rngFind.Offset(0, 9).Copy
         ThisWorkbook.ActiveSheet.Cells(11, 3).PasteSpecial Paste:=xlPasteValues
          
             
         rngFind.Offset(0, 10).Copy
         ThisWorkbook.ActiveSheet.Cells(9, 4).PasteSpecial Paste:=xlPasteValues
          
          
         rngFind.Offset(0, 11).Copy
         ThisWorkbook.ActiveSheet.Cells(10, 4).PasteSpecial Paste:=xlPasteValues
          
          
         rngFind.Offset(0, 12).Copy
         ThisWorkbook.ActiveSheet.Cells(11, 4).PasteSpecial Paste:=xlPasteValues
          
           
         rngFind.Offset(0, 13).Copy
         ThisWorkbook.ActiveSheet.Cells(9, 5).PasteSpecial Paste:=xlPasteValues
          
             
         rngFind.Offset(0, 14).Copy
         ThisWorkbook.ActiveSheet.Cells(10, 5).PasteSpecial Paste:=xlPasteValues
          
          
         rngFind.Offset(0, 15).Copy
         ThisWorkbook.ActiveSheet.Cells(11, 5).PasteSpecial Paste:=xlPasteValues
           
              
       Else
         MsgBox "Das Datum wurde nicht gefunden!"
       End If
       
    
    Application.CutCopyMode = False
    
    Workbooks("Schichteinteilung.xlsm").Close SaveChanges:=False
             
    ActiveSheet.Protect ("MHS"), DrawingObjects:=True, Contents:=True, Scenarios:=True
    
    With Application
      .ScreenUpdating = True
      .Calculation = xlCalculationAutomatic
    End With
    
    ThisWorkbook.Saved = True
    Application.DisplayAlerts = True
    End With
    End If
    End If
    End Sub
    
     
    Marcel1002, 21. Januar 2019
    #5
  6. Beverly
    Beverly Erfahrener User
    Also ich würde den Code so schreiben:

    Code:
    Sub Datenübernahme()
        Dim WKS As Worksheet
        Dim WKSZiel As Worksheet
        Dim strWks As String
        Dim rngFind As Range
        Dim strDate As String
        With Application
          .DisplayAlerts = False
          .ScreenUpdating = False
          .Calculation = xlCalculationManual
        End With
        Set WKSZiel = ActiveSheet
        WKSZiel.Unprotect ("MHS")
        Workbooks.Open Filename:="\\HECSOFILER01\Global-Data\MCO-Produktion\Schichteinteilung\Schichteinteilung.xlsm", Password:="2019", ReadOnly:=True
        strWks = InputBox("Team A, B, C, D oder E angeben:", , "A")
        If strWks <> "" Then
            On Error Resume Next
            Err.Clear
            Set WKS = Worksheets(strWks)
            If Err.Number > 0 Then
                Beep
                MsgBox "Team nicht gefunden! Eingabe richtig?"
            Else
                strDate = Format(Date, "YYYY-MM-DD")
                strDate = InputBox("Datum:", , strDate)
                If strDate <> "" Then
                    With WKS
                        Set rngFind = .Cells.Find(DateValue(strDate), LookIn:=xlValues, LookAt:=xlWhole)
                        If Not rngFind Is Nothing Then
                            .Range("A2").Copy
                            WKSZiel.Cells(4, 5).PasteSpecial Paste:=xlPasteValues
                            
                            rngFind.Offset(0, 0).Copy
                            WKSZiel.Cells(2, 5).PasteSpecial Paste:=xlPasteValues
                    
                            rngFind.Offset(0, 2).Copy
                            WKSZiel.Cells(6, 2).PasteSpecial Paste:=xlPasteValues
                            
                            rngFind.Offset(0, 3).Copy
                            WKSZiel.Cells(6, 4).PasteSpecial Paste:=xlPasteValues
                            
                            rngFind.Offset(0, 4).Copy
                            WKSZiel.Cells(9, 2).PasteSpecial Paste:=xlPasteValues
                            
                            rngFind.Offset(0, 5).Copy
                            WKSZiel.Cells(10, 2).PasteSpecial Paste:=xlPasteValues
                            
                            rngFind.Offset(0, 6).Copy
                            WKSZiel.Cells(11, 2).PasteSpecial Paste:=xlPasteValues
                            
                            rngFind.Offset(0, 7).Copy
                            WKSZiel.Cells(9, 3).PasteSpecial Paste:=xlPasteValues
                            
                            rngFind.Offset(0, 8).Copy
                            WKSZiel.Cells(10, 3).PasteSpecial Paste:=xlPasteValues
                            
                            rngFind.Offset(0, 9).Copy
                            WKSZiel.Cells(11, 3).PasteSpecial Paste:=xlPasteValues
                                
                            rngFind.Offset(0, 10).Copy
                            WKSZiel.Cells(9, 4).PasteSpecial Paste:=xlPasteValues
                            
                            rngFind.Offset(0, 11).Copy
                            WKSZiel.Cells(10, 4).PasteSpecial Paste:=xlPasteValues
                            
                            rngFind.Offset(0, 12).Copy
                            WKSZiel.Cells(11, 4).PasteSpecial Paste:=xlPasteValues
                              
                            rngFind.Offset(0, 13).Copy
                            WKSZiel.Cells(9, 5).PasteSpecial Paste:=xlPasteValues
                                
                            rngFind.Offset(0, 14).Copy
                            WKSZiel.Cells(10, 5).PasteSpecial Paste:=xlPasteValues
                            
                            rngFind.Offset(0, 15).Copy
                            WKSZiel.Cells(11, 5).PasteSpecial Paste:=xlPasteValues
                            
                            Workbooks("Schichteinteilung.xlsm").Close SaveChanges:=False
                            WKSZiel.Protect ("MHS"), DrawingObjects:=True, Contents:=True, Scenarios:=True
                            ThisWorkbook.Saved = True
                        Else
                            MsgBox "Das Datum wurde nicht gefunden!"
                        End If
                    End With
                End If
            End If
        End If
        Set WKS = Nothing
        Set WKSZiel = Nothing
        Set rngFind = Nothing
        With Application
            .DisplayAlerts = True
            .ScreenUpdating = True
            .Calculation = xlCalculationAutomatic
        End With
    End Sub
    Bis später,
    Karin
     
    Beverly, 21. Januar 2019
    #6
  7. Guten Morgen,

    vielen vielen Dank für den Code und deine Hilfe. Die Abfrage funktioniert, das flacken ist zwar noch vorhanden aber deutlich reduziert.
    Ich denke mal das bekommen wir nicht ganz weg, oder?

    Könnest du mir evtl. auch behilflich dein bei der Userfrom um die Eingabe ohne Inputbox zu lösen, wäre für ein Touch einfacher zu handeln.
    Ich lad nachher mal eine Datei hoch als Beispiel
     
    Marcel1002, 22. Januar 2019
    #7
  8. Flackern bei Makro abstellen und Abfrage evtl ändern

    Hallo, hier noch das Beispiel. Ist wie folgt gedacht.

    Userform geht beim Start auf.

    Auswahl von Team und Datum, danach Daten importieren (also Makro ausführen)
    Die Userform mit den zwei Eingaben ersetzt dann die Inputboxen.
    Soweit die Theorie.
    Ich weiss leider nicht wie umsetzen, daher mal ein einfaches Beispiel in der der Datei die ich mit hochlade...
     
    Marcel1002, 22. Januar 2019
    #8
  9. Beverly
    Beverly Erfahrener User
    Hi,

    auch wenn ich nicht nachvollziehen kann, weshalb und an welcher Stelle da ein großartiges Flackern zu sehen wäre könntest du den Code noch nach dem folgenden Prinzip ändern:

    Code:
                        If Not rngFind Is Nothing Then
                            WKSZiel.Cells(4, 5).Value = .Range("A2").Value
                            
                            WKSZiel.Cells(2, 5).Value = rngFind.Offset(0, 0).Value
                    
                            WKSZiel.Cells(6, 2).Value = rngFind.Offset(0, 2).Value
    
                            '... hier der Rest
    
                            Workbooks("Schichteinteilung.xlsm").Close SaveChanges:=False
                            WKSZiel.Protect ("MHS"), DrawingObjects:=True, Contents:=True, Scenarios:=True
                            ThisWorkbook.Saved = True
                        Else
                            MsgBox "Das Datum wurde nicht gefunden!"
                        End If
    

    Eventuell schafft das ja Abhilfe.

    Zu deiner anderen Frage: eröffne bitte ein neues Thema, denn niemand wird in diesem Thread hier nach einem Problem mit einem UserForm suchen. Und gleich noch ein Hinweis - du solltest schon vorgeben, bis zu welchem Tag die Datumswerte in der ListBox aufgelistet werden sollen.

    Bis später,
    Karin
     
    Beverly, 22. Januar 2019
    #9
  10. Genial, durch diese Änderung ist das flackern weg. Perfekt vielen lieben Dank!!!!
    Ich mach dann ein neues Thema.
    LG Marcel
     
    Marcel1002, 22. Januar 2019
    #10
  11. Flyer1301 Erfahrener User
    Hallo,
    das gleiche flackern tritt bei mir auch auf. Ich möchte kein neues Thema eröffnen.
    Vielleicht kann mir auch jemand behilflich sein.
    Nach dem Öffnen der Datei wird ein neuer Eintrag im Blatt "Statistik" mit Datum und Uhrzeit eingetragen und gespeichert.

    Code:
         'Statistik
    On Error Resume Next
    Application.ScreenUpdating = False
     
    Sheets("Statistik").Select
    Range("A1").Select
    Range("A1").Activate
    
    Do While ActiveCell.Value <> Empty
    ActiveCell.Offset(1, 0).Select
    Loop
    
    ActiveCell.Value = Format(Now, "dd.mm.yyyy")
    Application.ScreenUpdating = True
    
    On Error Resume Next
    Application.ScreenUpdating = False
     
    Sheets("Statistik").Select
    Range("B1").Select
    Range("B1").Activate
    
    Do While ActiveCell.Value <> Empty
    ActiveCell.Offset(1, 0).Select
    Loop
    
    ActiveCell.Value = Format(Now, "hh:mm:ss")
    Application.ScreenUpdating = True
    
    ActiveWorkbook.Save
     
    Zuletzt bearbeitet: 27. Januar 2019
    Flyer1301, 27. Januar 2019
    #11
  12. Beverly
    Beverly Erfahrener User
    Hi,

    das Flackern kommt durch deine Select-Anweisungen - der Cursor ist doch kein Hund, der auf dem Tabellenblatt Spazieren geführt werden muss... ;)

    Code:
    Dim lngErste As Long
    Application.ScreenUpdating = False
    With Worksheets("Statistik")
        lngErste = IIf(IsEmpty(.Cells(.Rows.Count, 1)), .Cells(.Rows.Count, 1).End(xlUp).Row, .Rows.Count) + 1
        .Cells(lngErste, 1) = Date
        lngErste = IIf(IsEmpty(.Cells(.Rows.Count, 2)), .Cells(.Rows.Count, 2).End(xlUp).Row, .Rows.Count) + 1
        .Cells(lngErste, 2) = Date
    End With
    Application.ScreenUpdating = True
    ActiveWorkbook.Save
    
    
    Bis später,
    Karin
     
    Beverly, 27. Januar 2019
    #12
  13. Flyer1301 Erfahrener User

    Flackern bei Makro abstellen und Abfrage evtl ändern

    Hallo Karin,
    wenn man sich nicht zu helfen weiß, ist das mit dem Cursor wie mit den Kanonen und den Spatzen oder das Angeln mit Dynamit. Nicht gerade effizient, aber es funktioniert bedingt. Flackern bei Makro abstellen und Abfrage evtl ändern :eek:

    Dein Code habe ich etwas angepasst und es läuft prima:
    Code:
     Dim lngErste As Long
    Application.ScreenUpdating = False
    With Worksheets("Statistik")
        lngErste = IIf(IsEmpty(.Cells(.Rows.Count, 1)), .Cells(.Rows.Count, 1).End(xlUp).Row, .Rows.Count) + 1
        .Cells(lngErste, 1) = Format(Now, "dd.mm.yyyy")
        lngErste = IIf(IsEmpty(.Cells(.Rows.Count, 2)), .Cells(.Rows.Count, 2).End(xlUp).Row, .Rows.Count)
        .Cells(lngErste, 2) = Format(Now, "hh:mm:ss")
    End With
    Application.ScreenUpdating = True
    ActiveWorkbook.Save
    Danke Dir recht herzlich!
     
    Flyer1301, 28. Januar 2019
    #13
  14. Beverly
    Beverly Erfahrener User
    Hi,

    du weißt schon dass du mit dem Befehl = Format(Now, "dd.mm.yyyy") einen Text in die Zelle schreibst??? Benutze doch einfach so wie ich = Date, dann musst du nichts formatieren und das Datum ist tatsächlich ein Datum als Zahlenwert. Und wenn du die Uhrzeit eintragen willst, nimm lieber Time anstelle Now und formatiere die Zelle anschließend:

    Code:
        .Cells(lngErste, 2) = Time
        .Cells(lngErste, 2).NumberFormat = "hh:mm:ss"
    
    
    Bis später,
    Karin
     
    Beverly, 28. Januar 2019
    #14
  15. Flyer1301 Erfahrener User
    Perfekt, danke!

    Das Datum wurde 1.28.2019 geschrieben, deshalb habe ich dank deines Tipps (Time) dies hinzu gefügt:
    Code:
    .Cells(lngErste, 1) = Date
        .Cells(lngErste, 1).NumberFormat = "dd.mm.yyyy"
    Gruß
     
    Flyer1301, 28. Januar 2019
    #15
Thema:

Flackern bei Makro abstellen und Abfrage evtl ändern

Die Seite wird geladen...
  1. Flackern bei Makro abstellen und Abfrage evtl ändern - Similar Threads - Flackern Makro abstellen

  2. Flackern trotz Application.ScreenUpdating = False

    in Microsoft Excel Hilfe
    Flackern trotz Application.ScreenUpdating = False: Hallo zusammen, ich probier schon eine Weil an dem nachfolgenden herum. Seit ich diese beiden Codes zum Hauptmakro ergänzt habe, springt er trotz Application.ScreenUpdating = False hin und her....
  3. Formular-Flackern

    in Microsoft Access Hilfe
    Formular-Flackern: Hallo Zusammen, wenn eine Zeitdifferenz in einem Formular anzeigen lassen will, flackert die Oberfläche. Wie kann ich das vermeiden? Habe schon etwas vom Echo off gelesen und eingebaut ... bringt...
  4. Flackern beim Scrollen in Formular verhindern?

    in Microsoft Access Hilfe
    Flackern beim Scrollen in Formular verhindern?: Guten Tag, habe hier eine Access DB mit einem Formular, was für die Bearbeitung und Erstellung von Datensätzen genutzt wird. Das Formular hat ca 40 Felder, in die Daten eingetragen werden...
  5. Starkes Flackern bei Navigieren von Datensätzen

    in Microsoft Access Hilfe
    Starkes Flackern bei Navigieren von Datensätzen: Hallo, ich habe folgendes Problem. Jedesmal wenn ich auf den Navigationstasten klicke(Datensatz vor-zurück erste DS letzter DS) dann flackert der Bildschirm sehr stark. Das geht teilweise so weit,...
  6. Flackern bei Mausbewegung auf Bezeichnungsfeld

    in Microsoft Access Hilfe
    Flackern bei Mausbewegung auf Bezeichnungsfeld: Hallo, ich habe ein Formular mit einem Registerelement. In dem Registerelement habe ich verschiedene Textfelder und Bezeichnungsfelder (ungebunden Bezeichnungsfelder). Wenn ich mit der Maus...
  7. Visio Grafiken flackern in Word Dokumenten

    in Microsoft Word Hilfe
    Visio Grafiken flackern in Word Dokumenten: Hallo In unserer Firma haben einige Clients seit unserem letzen Rollout(neue HP Elitebooks) das Problem, dass im Word 02 die Visio Grafiken flackern. Ich hab schon auch nach dem Problem...
  8. command button flackern

    in Microsoft Excel Hilfe
    command button flackern: hallo liebe excel freunde, ich hab auf einer excelseite in zelle A1 eine "laufende uhr" mittels code eingebaut. jetzt flackern alle commanbuttons auf deiser seite, ausserdem lässt sich der...
  1. Diese Seite verwendet Cookies, um Inhalte zu personalisieren, diese deiner Erfahrung anzupassen und dich nach der Registrierung angemeldet zu halten.
    Auf dieser Website werden Cookies für die Zugriffsanalyse und Anzeigenmessung verwendet.
    Wenn du dich weiterhin auf dieser Seite aufhältst, akzeptierst du unseren Einsatz von Cookies.
    Information ausblenden