Microsoft Excel

Herbers Excel/VBA-Archiv

Informationen und Beispiele zum Thema MsgBox
BildScreenshot zu MsgBox MsgBox-Seite mit Beispielarbeitsmappe aufrufen

Bitte um Hilfe bei Code Optimierung

Betrifft: Bitte um Hilfe bei Code Optimierung von: Olaf
Geschrieben am: 31.07.2014 11:46:02

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

  

Betrifft: Doppelt von: Hajo_Zi
Geschrieben am: 31.07.2014 11:47:00

https://www.herber.de/forum/messages/1373339.html


  

Betrifft: AW: Bitte um Hilfe bei Code Optimierung von: Michael
Geschrieben am: 31.07.2014 12:21:27

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


  

Betrifft: AW: Bitte um Hilfe bei Code Optimierung von: Olaf
Geschrieben am: 31.07.2014 13:15:10

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


  

Betrifft: die Du haben WILLST von: Michael
Geschrieben am: 31.07.2014 13:48:51

Nach dem Absenden ist mir noch eingefallen: nen Filter setzen?


  

Betrifft: AW: Bitte um Hilfe bei Code Optimierung von: Michael
Geschrieben am: 31.07.2014 13:44:30

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
' <<< eingefügt
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
'gelöscht: >>>>
'    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


  

Betrifft: AW: Bitte um Hilfe bei Code Optimierung von: Olaf
Geschrieben am: 31.07.2014 14:34:14

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


  

Betrifft: Ok von: Michael
Geschrieben am: 01.08.2014 11:24:15

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