Live-Forum - Die aktuellen Beiträge
Datum
Titel
28.03.2024 21:12:36
28.03.2024 18:31:49
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:45:18
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

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

Betreff
Datum
Anwender
Anzeige
AW: Bitte um Hilfe bei Code Optimierung
31.07.2014 12:41:12
Daniel
Hi
spricht was dagegen, statt der Schleife ab Zeile 17 einfach den Autofilter zu setzen?
das ist viel schneller als jede Zeile einzeln auszublenden.
der Recorder ist dein Freund.
Gruß Daniel

AW: Bitte um Hilfe bei Code Optimierung
31.07.2014 13:30:07
Olaf
Ciao Daniel
Danke für den Hinweis! Bin gerade am Pröbeln :-)
Gruss Olaf

AW: Bitte um Hilfe bei Code Optimierung
31.07.2014 13:54:06
Rudi
Hallo,
erst sammeln dann ausblenden.
Teste mal:
Sub Staffing()
Dim wks As Worksheet
Dim WSheetC As String
Dim WSheetP As String
Dim rngHide As Range
Application.DisplayAlerts = False
Application.ScreenUpdating = False
WSheetP = "Staffing"
WSheetC = "Vorhaben"
For Each wks In ActiveWorkbook.Worksheets
If wks.Name = WSheetP Then
wks.Delete
End If
Next wks
Application.DisplayAlerts = True
ActiveWorkbook.Worksheets.Add after:=Worksheets(Worksheets.Count)
ActiveSheet.Name = WSheetP
With Sheets(WSheetC)
LastRow = .Range("E65536").End(xlUp).Row
'MsgBox "Letzte Zeile ist Nr. " & LastRow
.Range("A1:K" & LastRow).Copy
Sheets(WSheetP).Cells(1, 1).PasteSpecial xlPasteAll
.Range("AB1:AB" & LastRow).Copy
Sheets(WSheetP).Range("L1:L" & LastRow).Insert
End With
With Sheets(WSheetP)
For i = 17 To LastRow
Select Case .Range("E" & i)
Case "Status Staffing", "Mitarbeiter Feasibility"
If rngHide Is Nothing Then
Set rngHide = .Rows(i)
Else
Set rngHide = Union(rngHide, .Rows(i))
End If
End Select
Next
If Not rngHide Is Nothing Then rngHide.Hidden = True
.Rows("1:15").Hidden = True
.Range("A:A").ColumnWidth = "50"
.Range("F:K").ColumnWidth = "15"
End With
With Sheets(WSheetC)
.Columns("D:D").EntireColumn.Hidden = True
.Columns("E:E").EntireColumn.Hidden = True
End With
Application.ScreenUpdating = True
End Sub

Gruß
Rudi
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige