Code langsamer nach printpreview
17.02.2009 12:13:00
Klaus
aus einer langen Mitarbeiterliste hole ich mir einzelne Datensätze nach gewissen Suchkriterien in ein Array, um dieses Array dann in der Ausgabeliste zu schreiben. Das geht super schnell!
Ein anderes Makro öffnet die Druckvorschau, diese schließe ich per Hand. Danach ist mein erstes Makro kriechend langsam!
Woran kann das liegen? Anbei mal der komplette Code
Option Explicit
Type Suchkriterium
xName As String
xPersonalNummer As String
Kostenstelle As String
Chef As String
Abteilung As String
End Type
Sub Eintragen()
Dim aSearch() As Suchkriterium
Dim lRow As Long
Dim myKostenstelle As String
Dim myChef As String
Dim myAbteilung As String
Dim ManCounter As Long
Dim lPpl As Long
lRow = Sheets("Datenblatt").Range("A65536").End(xlUp).Row
ReDim aSearch(0 To lRow)
With ActiveSheet
If IsEmpty(.Range("F2")) Then .Range("F2") = "#"
myKostenstelle = .Range("F2")
If IsEmpty(.Range("G2")) Then .Range("G2") = "#"
myChef = .Range("G2")
If IsEmpty(.Range("H2")) Then .Range("H2") = "#"
myAbteilung = .Range("H2")
End With
With Sheets("Datenblatt")
For ManCounter = 2 To lRow
If (InStr(1, .Range("E" & ManCounter), myAbteilung) > 0) Or (InStr(1, .Range("C" & _
ManCounter), myKostenstelle) > 0) Or (InStr(1, .Range("D" & ManCounter), myChef) > 0) Then
aSearch(lPpl).xName = .Range("A" & ManCounter)
aSearch(lPpl).xPersonalNummer = .Range("B" & ManCounter)
aSearch(lPpl).Kostenstelle = .Range("C" & ManCounter)
aSearch(lPpl).Chef = .Range("D" & ManCounter)
aSearch(lPpl).Abteilung = .Range("E" & ManCounter)
lPpl = lPpl + 1
End If
Next ManCounter
End With
With ActiveSheet
.Range("D8:Q500").ClearContents
.Range("D8:Q500").EntireRow.Hidden = False
For ManCounter = 8 To lPpl + 8
Range("D" & ManCounter) = aSearch(ManCounter - 7).xPersonalNummer
Range("E" & ManCounter) = aSearch(ManCounter - 7).xName
Range("F" & ManCounter) = aSearch(ManCounter - 7).Kostenstelle
Range("G" & ManCounter) = aSearch(ManCounter - 7).Chef
Range("H" & ManCounter) = aSearch(ManCounter - 7).Abteilung
Next ManCounter
.Range("D" & lPpl + 12 & ":D500").EntireRow.Hidden = True
.Range("E504") = Date
.Range("E507") = Environ("username")
End With
End Sub
Sub ausdrucken()
Dim lRow As Long
Dim r As Range
Application.ScreenUpdating = False
With ActiveSheet
lRow = .Range("E500").End(xlUp).Row + 1
For Each r In .Range("I8:I" & lRow)
If r.Value = "x" Then
Else
r.EntireRow.Hidden = True
End If
Next r
.PrintPreview
End With
Application.ScreenUpdating = True
End Sub
Grüße,
Klaus M.vdT.