noch schneller:
04.04.2013 15:12:29
Klaus
Hi,
der Vollständigkeit halber nochmal um den alseits beliebten "GetMoreSpeed" Standardsub ergänzt:
Sub ausblenden_schnell()
'Makro orignal by: ErichG
'https://www.herber.de/forum/messages/1306790.html
'geändert:
'Zeilen auszublenden (statt zu löschen)
'Auf Wort "Sommer" oder "" prüfen, statt auf doppler
'GetMoreSpeed Standardroutine eingefügt
Dim arrW, zz As Long, rngBlenden As Range
Dim iCol As Integer
Dim sKeep As String
Dim wksBlenden As Worksheet
'Hier den echten Tabellenblatt-Namen angeben!
Set wksBlenden = Sheets("Tabelle1")
'Hier die SPALTE angeben! Spalte G = 6 (A=1, B=2 usw)
iCol = 7
'Dieses Wort nicht ausblenden!
sKeep = "Sommer"
GetMoreSpeed (True)
With wksBlenden
arrW = .Cells(1, iCol).Resize(.Cells(.Rows.Count, iCol).End(xlUp).Row)
For zz = 2 To UBound(arrW)
If arrW(zz, 1) sKeep And arrW(zz, 1) "" Then
If rngBlenden Is Nothing Then
Set rngBlenden = .Cells(zz, 1)
Else
Set rngBlenden = Union(rngBlenden, .Cells(zz, 1))
End If
Else
End If
Next
If Not rngBlenden Is Nothing Then rngBlenden.EntireRow.Hidden = True
End With
GetMoreSpeed (False)
End Sub
Public Static Sub GetMoreSpeed(Optional ByVal Modus As Boolean = True)
Dim intCalculation As Integer
If Modus = True Then intCalculation = Application.Calculation
With Application
.ScreenUpdating = Not Modus
.EnableEvents = Not Modus
.Calculation = IIf(Modus = True, xlManual, intCalculation)
.Cursor = IIf(Modus = True, 2, -4143)
End With
End Sub
Grüße,
Klaus M.vdT.