Live-Forum - Die aktuellen Beiträge
Anzeige
Archiv - Navigation
1372to1376
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

Bitte um Hilfe bei Code Optimierung

Bitte um Hilfe bei Code Optimierung
31.07.2014 11:46:02
Olaf
Hallo
Als VBA-Anfänger brauche ich Eure Hilfe.Beiliegendes Macro kopiert Inhalte aus einer Mastertabelle auf ein neues Sheet, wo dann die Mehrheit der Zeilen wieder versteckt wird. Es funktioniert, aber leider ziemlich langsam :-/, da ca. 2000 Zeilen durchforstet werden müssen. Bin für jede Hilfe dankbar, die zur Beschleunigung beitragen. (insbesondere eine bessere Variante für die For-Schleife)Danke im Voraus!
Fred
Sub Staffing()
Dim wks As Worksheet
Dim WSheetC As String
Dim WSheetP As String
Application.DisplayAlerts = False
WSheetP = "Staffing"
WSheetC = "Vorhaben"
For Each wks In ActiveWorkbook.Worksheets
If wks.Name = WSheetP Then
Sheets(WSheetP).Delete
End If
Next
ActiveWorkbook.Worksheets.Add after:=Worksheets(Worksheets.Count)
ActiveSheet.Name = WSheetP
Application.DisplayAlerts = True
Sheets(WSheetC).SelectLastRow = Range("E65536").End(xlUp).Row
'MsgBox "Letzte Zeile ist Nr. " & LastRow
Sheets(WSheetC).Range("A1:K" & LastRow).Select
Sheets(WSheetC).Range("A1:K" & LastRow).Copy
Sheets(WSheetP).Cells(1, 1).PasteSpecial xlPasteAll
Sheets(WSheetC).Range("AB1:AB" & LastRow).Copy
Sheets(WSheetP).Range("L1:L" & LastRow).Insert
Application.ScreenUpdating = False
For i = 17 To LastRow
If Sheets(WSheetP).Range("E" & i) = "Status Staffing" Or Sheets(WSheetP).Range("E" & i) = " _
Mitarbeiter Feasibility" Then
Sheets(WSheetP).Rows(i).Hidden = False
Else
Sheets(WSheetP).Rows(i).Hidden = True
End If
Next
Sheets(WSheetP).Rows("1:15").Hidden = True
Sheets(WSheetP).Rows("16").Hidden = False
Columns("D:D").EntireColumn.Hidden = True
Columns("E:E").EntireColumn.Hidden = True
Sheets(WSheetP).Range("A:A").ColumnWidth = "50"
Sheets(WSheetP).Range("F:K").ColumnWidth = "15"
Application.ScreenUpdating = True
End Sub

7
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Bitte um Hilfe bei Code Optimierung
31.07.2014 12:21:27
Michael
Hallo Olaf,
ohne es (mangels Datei) ausprobiert zu haben ein Gedanke:
1. den kompletten Bereich auf hidden=false setzen, das geht in einem Rutsch,
2. in der For-Schleife nur noch hidden=true setzen, falls erforderlich
Oder umgekehrt, je nach dem, wovon Du mehr hast, hidden oder nicht hidden, das ist hier die Frage.
Jedenfalls sparst Du so mindestens die Hälfte der Zeit.
Ähm. Ich weiß nicht, wie es vom Zeitverhalten her aussieht, aber vielleicht isses hilfreich, nicht für jedes i den Befehl auszuführen, sondern ein Range zu verwenden, das Du zeilenweise erweiterst, um die Aktion anschließend auf das Range anzuwenden.
Schöne Grüße,
Michael

Anzeige
AW: Bitte um Hilfe bei Code Optimierung
31.07.2014 13:15:10
Olaf
Hallo Michael
Danke für deine rasche Antwort. Beiliegend die Beispieldatei.
https://www.herber.de/bbs/user/91811.xlsm
Das Macro ist im WSheet "Vorhaben" auf dem grünen Button referenziert.
PS: Mit zwei Projekten ist das ganze natürlich ziemlich schnell, aber mein Masterfile hat nahezu 2000 Zeilen und da wird's sehr mühsam (z.T. + 5 Min...).
Danke schon jetzt für dein Feedback.
Olaf

die Du haben WILLST
31.07.2014 13:48:51
Michael
Nach dem Absenden ist mir noch eingefallen: nen Filter setzen?

AW: Bitte um Hilfe bei Code Optimierung
31.07.2014 13:44:30
Michael
Hallo Olaf,
habe die Geschichte mal ein bißchen geglättet:
Sub Staffing()
Dim wks As Worksheet
Dim WSheetC As String
Dim WSheetP As String
Application.DisplayAlerts = False
WSheetP = "Staffing"
WSheetC = "Vorhaben"
For Each wks In ActiveWorkbook.Worksheets
If wks.Name = WSheetP Then
Sheets(WSheetP).Delete
End If
Next
ActiveWorkbook.Worksheets.Add after:=Worksheets(Worksheets.Count)
ActiveSheet.Name = WSheetP
Application.DisplayAlerts = True
Sheets(WSheetC).Select
LastRow = Range("E65536").End(xlUp).Row
' MsgBox "Letzte Zeile ist Nr. " & LastRow
'gelöscht: >>>>
'Sheets(WSheetC).Range("A1:K" & LastRow).Select
Sheets(WSheetC).Range("A1:K" & LastRow).Copy
Sheets(WSheetP).Cells(1, 1).PasteSpecial xlPasteAll
Sheets(WSheetC).Range("AB1:AB" & LastRow).Copy
Sheets(WSheetP).Range("L1:L" & LastRow).Insert
Application.ScreenUpdating = False
' eingefügt >>>>
Sheets(WSheetP).Rows("1:" & LastRow).Hidden = True
' >>>
'    Else
'    Sheets(WSheetP).Rows(i).Hidden = True
'    End If
Next
'gelöscht, weil oben bereits enthalten: >>>>
'    Sheets(WSheetP).Rows("1:15").Hidden = True
Sheets(WSheetP).Rows("16").Hidden = False
Columns("D:D").EntireColumn.Hidden = True
Columns("E:E").EntireColumn.Hidden = True
Sheets(WSheetP).Range("A:A").ColumnWidth = "50"
Sheets(WSheetP).Range("F:K").ColumnWidth = "15"
Application.ScreenUpdating = True
End Sub
Bei mir tut's.
Abgesehen davon: bist Du sicher, daß Du die Zeilen *ausblenden* willst? Es ist mit weniger Datenaufkommen möglich, nur die Zeilen, die Du haben, ins neue Blatt zu kopieren. Nur so ne Idee.
Schöne Grüße,
Michael

Anzeige
AW: Bitte um Hilfe bei Code Optimierung
31.07.2014 14:34:14
Olaf
Ciao Michael
Danke vielmals für deine Mühe!
PS: Habe einige Bezüge in den Zellen, die nicht mehr funktionieren würden, wenn ich nur die paar Zeilen kopiere. Da hatte ich auch schon geübt.
Hast mir auf jedenfall geholfen :-)
Gruss Olaf

Ok
01.08.2014 11:24:15
Michael
Hallo Olaf,
das liegt wahrscheinlich an den verbundenen Zellen in Spalte A - das ist immer hakelig.
Wenn es so weit rennt, isses ja wurscht.
Danke für das feedback!
Happy Exceling,
Michael

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige