Live-Forum - Die aktuellen Beiträge
Datum
Titel
19.04.2024 17:05:40
Zählen von Zeilen, in denen in bestimmten Bereich Daten sind
19.04.2024 16:34:52
gemeinsamer Filter über drei Spalten
19.04.2024 15:39:42
Exceltabelle daten per combobox zu word Datei
19.04.2024 14:04:05
PDF per VBA ausgeben - Seitenskalierung
Du findest keine passende Antwort auf Deine Frage?
Stelle Deine Frage in unserem Live-Forum
Anzeige
Archiv - Navigation
1592to1596
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Vorheriger Thread
Vorheriger Thread
Rückwärts Blättern
1592to1596
1592to1596
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Nächster Thread
Nächster Thread
Vorwärts blättern
Inhaltsverzeichnis

Performance beim Ausführen.

Performance beim Ausführen.
22.11.2017 13:27:56
Georg
Liebe Mitstreiter,
ich habe ein ganz allgemeine Frage: der folgende Code erzeugt einen Kalender, Starttermin wird vorab abgefragt, es folgen dann noch weitere Codezeilen.
Was ich wissen möchte, der Code für den Kalender läuft extrem langsam ab, ich kann dabei Zeile/Spalte für Zeile/Spalte zuschauen:
Ist das normal oder kann ich das i-wie beschleunigen? DANKE
With Tabelle1
Range("c4") = PlJahr
Range("c6") = StartMonat
'Kalender für Planungszeitraum erzeugen
For Monat = start To Monat
zeile = 4
ersterTag = CDate("01." & Monat & "." & jahr)
letzterTag = DateSerial(Year(ersterTag), Month(ersterTag) + 1, 0)
.Cells(zeile - 1, spalte) = ersterTag
For tag = ersterTag To letzterTag
.Cells(zeile, spalte) = tag
.Cells(zeile, spalte + 1) = Weekday(tag)
If Weekday(tag) = 1 Or Weekday(tag) = 7 Then
.Cells(zeile, spalte).Interior.Color = RGB(222, 222, 222)
.Cells(zeile, spalte + 1).Interior.Color = RGB(222, 222, 222)
End If
'Feiertage markieren
Select Case tag
Case DateSerial(Year(tag), 1, 1)
.Cells(zeile, spalte + 1).Interior.Color = vbYellow
Case DateSerial(Year(tag), 1, 6)
.Cells(zeile, spalte + 1).Interior.Color = vbYellow
Case Ostern(Year(tag)) - 2
.Cells(zeile, spalte + 1).Interior.Color = vbYellow
Case Ostern(Year(tag))
.Cells(zeile, spalte + 1).Interior.Color = vbYellow
Case Ostern(Year(tag)) + 1
.Cells(zeile, spalte + 1).Interior.Color = vbYellow
Case DateSerial(Year(tag), 5, 1)
.Cells(zeile, spalte + 1).Interior.Color = vbYellow
Case Ostern(Year(tag)) + 39
.Cells(zeile, spalte + 1).Interior.Color = vbYellow
Case Ostern(Year(tag)) + 49
.Cells(zeile, spalte + 1).Interior.Color = vbYellow
Case Ostern(Year(tag)) + 50
.Cells(zeile, spalte + 1).Interior.Color = vbYellow
Case Ostern(Year(tag)) + 60
.Cells(zeile, spalte + 1).Interior.Color = vbYellow
Case DateSerial(Year(tag), 8, 15)
.Cells(zeile, spalte + 1).Interior.Color = vbYellow
Case DateSerial(Year(tag), 10, 3)
.Cells(zeile, spalte + 1).Interior.Color = vbYellow
Case DateSerial(Year(tag), 11, 1)
.Cells(zeile, spalte + 1).Interior.Color = vbYellow
Case DateSerial(Year(tag), 12, 24)
.Cells(zeile, spalte + 1).Interior.Color = vbYellow
Case DateSerial(Year(tag), 12, 25)
.Cells(zeile, spalte + 1).Interior.Color = vbYellow
Case DateSerial(Year(tag), 12, 26)
.Cells(zeile, spalte + 1).Interior.Color = vbYellow
Case DateSerial(Year(tag), 12, 31)
.Cells(zeile, spalte + 1).Interior.Color = vbYellow
End Select
zeile = zeile + 1
Next tag
.Columns(spalte).NumberFormat = "DD.MM.YY"
.Columns(spalte + 1).NumberFormat = "DDD"
.Columns(spalte).ColumnWidth = 5.5
.Columns(spalte + 1).ColumnWidth = 4
spalte = spalte + 2
Next Monat
.Rows(3).NumberFormat = "MMM"
.Rows(3).Font.Bold = True
.Rows(3).Font.Size = 8
End With
'Formatieren
Range("w4:AT34").Select
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.ColorIndex = xlAutomatic
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.ColorIndex = xlAutomatic
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.ColorIndex = xlAutomatic
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.ColorIndex = xlAutomatic
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlInsideVertical)
.LineStyle = xlContinuous
.ColorIndex = xlAutomatic
.TintAndShade = 0
.Weight = xlHairline
End With
With Selection.Borders(xlInsideHorizontal)
.LineStyle = xlContinuous
.ColorIndex = xlAutomatic
.TintAndShade = 0
.Weight = xlHairline
End With
Range("W4:AT34").Select
Selection.Font.Size = 7
With Selection.Font
.ThemeColor = xlThemeColorDark1
.TintAndShade = -0.349986266670736
End With

3
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Performance beim Ausführen.
22.11.2017 13:54:59
Peter(silie)
Hallo,
das erstellen deines Kalenders machst du einem Sub und die Formatierung in einem eigenen.
Das eine hat nichts mit dem anderen zu tun, deshalb gehören die auch
getrennt.
Solche gigantischen Cases durchlaufen zu lassen macht keinen Sinn in einer Schleife.
Warum verwendest du nicht einfach Bedingte Formatierungen?
Hier noch Bsp Code: 
Sub a()
Dim d As Date
d = "1.1.2016"
Add_Dates d, 10000
Format_Dates 10000
End Sub
Private Sub Add_Dates(ByVal start_ As Date, ByVal number_of_Days As Long)
Dim i As Long
For i = 0 To number_of_Days
Cells(i + 1, 1) = start_ + i
Next i
End Sub
Private Sub Format_Dates(ByVal Number_of_Rows As Long)
Dim i As Long
Dim tmp As String
For i = 1 To Number_of_Rows
tmp = Cells(i, 1).Value
Select Case tmp
Case DateSerial(Year(tmp), 1, 1)
Cells(i, 1).Interior.Color = vbYellow
Case Else:
End Select
Next i
End Sub

Anzeige
AW: Performance beim Ausführen.
22.11.2017 14:24:14
Nepumuk
Hallo Peter,
datenreihen ausfüllen machst du besser so:
Public Sub Test()
    Cells(1, 1).Value = DateSerial(2017, 1, 1)
    Call Range(Cells(1, 1), Cells(1000, 1)).DataSeries
End Sub

Die Methode DataSeries hat mehrere Parameter, schau dir die mal in der Hilfe an.
Gruß
Nepumuk
Anzeige
AW: Performance beim Ausführen.
22.11.2017 14:51:32
fcs
Hallo Georg,
grundsätzlich ist es ratsam, während der Makro-Ausführung die Bildschirmaktualisierung zu beginn des makros zu deaktivieren und am Ende wieder zu aktivieren.
Wenn in dem Tabellenblatt Formeln enthalten sind und Werte per Makro eingetragen werden, dann sollte der Berechnungsmodus vorübergehend auf manuell gesetzt und nur bei Bedarf Excel/einTaellenblatt/ein Zellbereich neu berechent werden. 
'vor dem Beginn umfangreicher Zellbearbeitungen und -formatierungen
'Makrobremsen lösen
Dim StatusCalc As Long
With Application
.ScreenUpdating = False
'       .EnableEvents = False 'wenn Ereignismakros eingesetzt werden
StatusCalc = .Calculation 'Berechnungsmodus merken
.Calculation = xlCalculationManual
End With
'Makrobremsen zurücksetzen
With Application
.ScreenUpdating = True
'       .EnableEvents = True    'wenn Ereignismakros eingesetzt werden
.Calculation = StatusCalc
End With
Gruß
Franz
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Jetzt das Excel-Portal bewerten: Deine Stimme zählt!

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige