Makro Beschleunigen (Spalten im Druckbereich ausblenden)

[cb123]

Hallo Liebe Gemeinde,

Aus nicht mehr nachvollziehbarem Grund hat mein Makro an Geschwindigkeit verloren. Es prüft in Zeile 3 ob eine "1" dort steht und blendet entsprechende Spalten aus oder ein. Es sollen 680 Spalten geprüft werden. Vor langer Zeit hatte ich sogar 1000 Spalten in der Prüfung und habe diese dann im Zuge des Beschleunigungsversuchs verringert. Ausgeführt wird das Makro über Anklicken eines Symbols. Hier der das Makro:

Sub Spalten_ausblenden()

Application.ScreenUpdating = False
For i = 1 To 680
If Cells(3, i).Value = "" Then
    Columns(i).Hidden = True
End If
If Cells(3, i).Value = "1" Then
    Columns(i).Hidden = False
End If
Next i
Application.ScreenUpdating = True
Range("A1").Select

End Sub 

Jemand einen Tip? 

Lieben Gruß 

Christoph

[UweD]

Hallo

anstelle Schleife und 2x If

so...

Code:

   For i = 1 To 680
       Columns(i).Hidden = Cells(3, i).Value = ""
   Next i
   

LG Uwe

[Storax]

Und damit wird es dann noch 1ms schneller, aber der Tipp von @UweD ist natürlich entscheidend.

Columns(i).Hidden = Cells(3, i).Value = vbNullString

Noch eine Mikro-Optimierung . Nach meinen Messungen wird es dann nochmal ein paar ms schneller :19:

Code:

Option Explicit

Public Declare Function GetTickCount Lib "kernel32.dll" () As Long

Sub Spalten_ausblenden_A()
   Dim i As Long
   Dim vDat As Variant
   
   Dim starttime As Long
   Dim timeelapsed As Long
   starttime = GetTickCount()
   
   With ActiveSheet
       vDat = .Range(.Cells(3, 1), .Cells(3, 680))
   End With
   
   Dim rg As Range
   
   For i = 1 To 680
       If vDat(1, i) = vbNullString Then
           If rg Is Nothing Then
               Set rg = Columns(i)
           Else
               Set rg = Union(rg, Columns(i))
           End If
       End If
   Next i
       
   rg.Columns.Hidden = True
   
   timeelapsed = (GetTickCount() - starttime)
   Debug.Print timeelapsed / 1000
End Sub

[cb123]

vielen Lieben Dank. Ich habe jetzt lange hin und zurück überlegt und probiert. Mein Fehler scheint aber an anderer Stelle zu liegen. Ich einer älteren Version meiner Datei läuft dieses Makro auch noch fix durch (ca. 5s). Auch nach euren Versionen brauche ich ca. 1min.
Das Makro scheint "extern" behindert zu werden. Habt ihr vielleicht eine Idee?

Lieben Gruß

Christoph

[Storax]

Evtl. hast Du volatile Formeln hinzugefügt, die das Blatt ausbremsen .. oder ...
Also am besten Beispieldatei, wo das Problem auftritt, hochladen.

[UweD]

oder hast du Events, die noch ausgeführt werden..

Kalkulation und events abschalten..

Code:

Private Sub tt()
   Const APPNAME = "Dein MakroName"
   
   '*** bescheunigt das Makro
   With Application
       .ScreenUpdating = False
       .EnableEvents = False
       .Calculation = xlCalculationManual
   End With
   '***
   
   'Dein Makro hier
   For i = 1 To 680
       Columns(i).Hidden = Cells(3, i).Value = ""
   Next i
   
   
   
   
   '*** Fehlerbehandlung
   Err.Clear
Fehler:
   If Err.Number <> 0 Then MsgBox "Fehler in Sub """ & APPNAME & """" & vbCrLf _
       & "Fehlernummer: " & Err.Number & vbLf & Err.Description: Err.Clear
   '*** Rücksetzen
   With Application
       .EnableEvents = True
       .ScreenUpdating = True
       .Calculation = xlCalculationAutomatic
   End With
   '***
End Sub

LG UweD

[cb123]

Hi!

Beide Vorschläge kann ich in meiner Tabelle nicht finden. Ich habe die Tabelle angehängt.

Der beschriebene Vorfall betrifft das Blatt "Einsatzplan" mit dem Makro "Spalten_ausblenden" welches durch einen Klick auf das "Minus Symbol" ungenutzte Spalten ausblendet. Das Makro prüft wie beschrieben die Zeile 3 in den Spalten i, ob ein Wert vorhanden ist. Der Wert ist vorhanden, wenn die Tage im Deckblatt als Zeitraum abgerufen werden.

In der Datei sind aktuell nur die Tage 1.1. bis 5.1.19 genutzt, alle anderen Tage sollen dann verschwinden um das Blatt so klein wir möglich zu halten. Im Blatt "Übersicht" funktioniert das ganz gut.

... habe einige Work arounds genutzt, für mich funktioniert die Tabelle aber gut. Es würde mir helfen, wenn Ihr mir einen Tipp gebt, die Wartezeit bis die Spalten ausgeblendet werden zu reduzieren. Über weitere Tipps bin ich natürlich dankbar, sind aber aktuell nur das Sahnehäubchen auf der Excel Torte.

Liebe Grüße

Christoph