Live-Forum - Die aktuellen Beiträge
Anzeige
Archiv - Navigation
1324to1328
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
Inhaltsverzeichnis

VBA Code schneller machen

VBA Code schneller machen
18.08.2013 19:59:10
Rebecca
Hallo Zusammen,
wenn ich in einer vba Prozedur zuviele Abfragen bzw. Ausführungen drin habe, verlangsamt diese die Ausführung? Ist es besser wenn ich eine große Prozedur in viele kleinen packe?
Irgendwie braucht das bei mir etwas zu lang.
LG
Rebecca

4
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: VBA Code schneller machen
18.08.2013 20:22:09
KlausF
Hallo Rebecca,
damit dir hier jemand helfen kann solltest du den Code mit Arbeitsmappe posten ...
Gruß
Klaus

AW: VBA Code schneller machen
18.08.2013 21:14:13
Rebecca
Hi Klaus,
klaro ... sorry ... hier der Code:
Private Sub Workbook_Open()
Application.ScreenUpdating = False
ActiveWindow.ScrollColumn = 1
Worksheets(6).Visible = True
Worksheets("Tabelle6").Select
With Cells(Sheets("Tabelle6").Cells(Rows.Count, 2).End(xlUp).Row + 1, 2)
.Select
.Value = Now & "  -  " & Environ("UserName")
pboNoSave = True
ActiveWorkbook.Save
End With
pboNoSave = False
Worksheets(6).Visible = False
Range("A1").Select
With Worksheets("Tabelle2")
Sheets("Tabelle2").Unprotect Password:="xxxx"
Select Case Environ("UserName")
Case "user1"
Application.ScreenUpdating = False
Worksheets("Tabelle2").Columns("AA:AB").Hidden = False
Worksheets("Tabelle3").Visible = True
Worksheets("Tabelle4").Visible = True
Worksheets("Tabelle6").Visible = True
Case "user3"
Application.ScreenUpdating = False
Worksheets("Tabelle4").Visible = False
Case Else
Application.ScreenUpdating = False
Worksheets("Tabelle2").Columns("AA:AB").Hidden = True
Worksheets("Tabelle2").Columns("AF:AN").Hidden = True
Worksheets("Tabelle3").Visible = False
Worksheets("Tabelle4").Visible = False
End Select
If .FilterMode Then .ShowAllData
Sheets("Tabelle1").EnableAutoFilter = True
Sheets("Tabelle1").Protect userinterfaceonly:=True, Password:="xxxx"
End With
Sheets("Tabelle1").Select
Range("A2").Select
dteCloseTime = Now + TimeSerial(0, 1, 0)
Application.OnTime dteCloseTime, "DoClose"
End Sub

Private Sub Workbook_BeforeClose(Cancel As Boolean)
On Error Resume Next
Application.OnTime dteCloseTime, "DoClose", , False
End Sub

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
On Error Resume Next
Application.OnTime dteCloseTime, "DoClose", , False
dteCloseTime = Now + TimeSerial(0, 1, 0)
blnCloseNow = False
Application.OnTime dteCloseTime, "DoClose"
End Sub

Private Sub Workbook_SheetDeactivate(ByVal Sh As Object)
On Error Resume Next
Application.OnTime dteCloseTime, "DoClose", , False
dteCloseTime = Now + TimeSerial(0, 1, 0)
blnCloseNow = False
Application.OnTime dteCloseTime, "DoClose"
End Sub

Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
On Error Resume Next
Application.OnTime dteCloseTime, "DoClose", , False
dteCloseTime = Now + TimeSerial(0, 1, 0)
blnCloseNow = False
Application.OnTime dteCloseTime, "DoClose"
End Sub

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
If pboNoSave = True Then Exit Sub
Dim APP_OUTLOOK As Object
Dim MESSAGE As Object
Dim STR_WKB_PATH As String
Set APP_OUTLOOK = CreateObject("Outlook.Application")
Set MESSAGE = APP_OUTLOOK.CreateItem(0)
STR_WKB_PATH = ActiveWorkbook.Path
Application.Quit
Dim Mail As String
Mail_GH = "aaa@aaa.de"
Mail_GZ = "bbb@bbb.de"
Mail_n = "ccc@ccc.de"
If Zelle = "Mail_GH" Then Mail = Mail_GH
If Zelle = "Mail_GZ" Then Mail = Mail_GZ
If Zelle = "Mail_N" Then Mail = Mail_n
With MESSAGE
.to = Mail
.BCC = "ddd@ddd.de"
.Subject = "bla ... bla ... bla" & "  -  " & Format(Now, "DD.MM.YY HH:MM")
.HTMLBody = "bla ... bla ... bla ... bla"
.Display
End With
Set APP_OUTLOOK = Nothing
Set MESSAGE = Nothing
End Sub

Anzeige
AW: VBA Code schneller machen
19.08.2013 09:57:00
fcs
Hallo Rebecca,
bis auf ein paar Zellselektionen, die man noch vermeiden könnte ist dein Workbook-Open-Makro in Ordnung. Das Aufbrechen in mehrere Teilmakros beschleunigt die Makroausführung normalerweise nicht. Es kann jedoch die Übersichtlichkeit und das Testen der Makros verbessern/vereinfachen. Dafür besteht hier aber keine Notwendigkeit.
Zusätzlich zur Bildschirmaktualisierung solltest du während der Ausführung des Makros noch die Berechnung auf manuell setzen und die Ereignismakros deaktivieren.
Das Workbook_BeforeSave-Makro mit dem E-Mail-Versand kann so nicht funktionieren. Die Zeile
Application.Quit
muss du verschieben vor End Sub und die Variable "Zelle" muss auch irgendwo mit dem entsprechenden Wert gefüllt werden.
Gruß
Franz
Private Sub Workbook_Open()
With Application
.ScreenUpdating = False
.Calculation = xlCalculationManual
.EnableEvents = False
End With
ActiveWindow.ScrollColumn = 1
Worksheets(6).Visible = True
Worksheets("Tabelle6").Select
With Cells(Sheets("Tabelle6").Cells(Rows.Count, 2).End(xlUp).Row + 1, 2)
.Select
.Value = Now & "  -  " & Environ("UserName")
pboNoSave = True
ActiveWorkbook.Save
End With
pboNoSave = False
Worksheets(6).Visible = False
Range("A1").Select
With Worksheets("Tabelle2")
Sheets("Tabelle2").Unprotect Password:="xxxx"
If .FilterMode Then .ShowAllData                 'evtl. hierher verschieben
Select Case Environ("UserName")
Case "user1"
Application.ScreenUpdating = False
Worksheets("Tabelle2").Columns("AA:AB").Hidden = False
Worksheets("Tabelle3").Visible = True
Worksheets("Tabelle4").Visible = True
Worksheets("Tabelle6").Visible = True
Case "user3"
Application.ScreenUpdating = False
Worksheets("Tabelle4").Visible = False
Case Else
Application.ScreenUpdating = False
Worksheets("Tabelle2").Columns("AA:AB").Hidden = True
Worksheets("Tabelle2").Columns("AF:AN").Hidden = True
Worksheets("Tabelle3").Visible = False
Worksheets("Tabelle4").Visible = False
End Select
Sheets("Tabelle1").EnableAutoFilter = True
Sheets("Tabelle1").Protect userinterfaceonly:=True, Password:="xxxx"
End With
Sheets("Tabelle1").Select
Range("A2").Select
dteCloseTime = Now + TimeSerial(0, 1, 0)
Application.OnTime dteCloseTime, "DoClose"
With Application
.ScreenUpdating = True
.Calculation = xlCalculationAutomatic
.EnableEvents = True
End With
End Sub

Anzeige
AW: VBA Code schneller machen
19.08.2013 09:59:26
Martin
Hallo Rebecca,
ich habe mal versucht ins erste Makro etwas Ordnung zu bringen. Ich hoffe, dass noch alles wie gewünscht klappt. Versuche in Zukunft möglichst ohne Select zu arbeiten. Auch das Ein- und Ausblenden von Tabelle6 verbraucht nur sinnlos Rechenleistung (...also Zeit). Hier mein Vorschlag:
Private Sub Workbook_Open()
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
With Worksheets("Tabelle6")
.Cells(.Cells(.Rows.Count, 2).End(xlUp).Row + 1, 2).Value = Now & "  -  " & Environ(" _
UserName")
End With
pboNoSave = True
ActiveWorkbook.Save
pboNoSave = False
With Worksheets("Tabelle2")
.Unprotect Password:="xxxx"
Select Case Environ("UserName")
Case "user1"
.Columns("AA:AB").Hidden = False
Worksheets(Array("Tabelle3", "Tabelle4", "Tabelle6")).Visible = False
Case "user3"
Worksheets("Tabelle4").Visible = False
Case Else
.Columns("AA:AB").Hidden = True
.Columns("AF:AN").Hidden = True
Worksheets(Array("Tabelle3", "Tabelle4")).Visible = False
End Select
If .FilterMode Then .ShowAllData
End With
With Sheets("Tabelle1")
.Select
.EnableAutoFilter = True
.Protect userinterfaceonly:=True, Password:="xxxx"
End With
Range("A2").Select
With Application
.ScreenUpdating = True
.Calculation = xlCalculationAutomatic
.OnTime Now + TimeSerial(0, 1, 0), "DoClose"
End With
End Sub
Viele Grüße
Martin
Anzeige

300 Forumthreads zu ähnlichen Themen

Anzeige
Anzeige
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige