AW: Filter
19.09.2013 13:51:48
Luschi
Hallo Matthias,
versuch es mal so:
Sub Machmal()
Dim ws As Worksheet, rg1 As Range, rg2 As Range, rg3 As Range
Dim s As String, n As Long
Debug.Print Time
Set ws = Tabelle1
'Suchbegriff
s = ws.Range("E1").Value
ws.Columns(1).EntireRow.Hidden = False
n = ws.Cells(ws.Rows.Count, 2).End(xlUp).Row
Set rg1 = ws.Range("B3:B" & n)
For Each rg2 In rg1
If rg2.Value "" Then
If InStr(1, rg2.Value, s, vbTextCompare) > 0 Then
If rg3 Is Nothing Then
Set rg3 = rg2
Else
Set rg3 = Application.Union(rg3, rg2)
End If
End If
End If
Next rg2
If Not (rg3 Is Nothing) Then
rg3.EntireRow.Hidden = True
Debug.Print rg3.Address
End If
Set rg3 = Nothing: Set rg2 = Nothing: Set rg1 = Nothing
Set ws = Nothing
Debug.Print Time
End Sub
Sub getMoreSpeed(xOk As Boolean)
Application.ScreenUpdating = xOk
Application.EnableEvents = xOk
If xOk Then
Application.Calculation = xlCalculationManual
Application.Cursor = xlWait
Else
Application.Calculation = xlCalculationAutomatic
Application.Cursor = xlDefault
End If
End Sub
Gruß von Luschi
aus klein-Paris