makro änderung

Hallo Excelfreunde,

ich blende mit dem untenstehenden Makro alle Zeilen/Zellen der aktiven spalte aus, bei den der Wert entweder nur Zahlen sind oder den Kriterien "F" "U" oder "K" ( genaue Übereinstimmung, groß bzw. Kleinschreibung soll nicht unterschieden werden) entsprechen aus.

Nun möchte ich aber diese Kriterien aus den Zell Bereich Tabelle1 C1 : c12 nehmen. Aber ich bekomme es nicht hin.

So funktioniert es
If Not IsNumeric(sval) And sval > "F" And sval > "U" And sval > "K" Then ' so geht es

So aber leider nicht:

For i = 1 To 12

'If Not IsNumeric(sval) And sval > Tabelle1.Cells(i, 3).Value Then
bAus = False
Exit For ' Abbruch der Schleife, sobald ein Kriterium erfüllt ist
End If
Next i

Es werden zwar noch alle Numerischen Werte ausgeblendet aber die Kriterien der Tabelle1 werden nicht berücksichtigt.

Was ist falsch?

Sub Ausblenden8()
Application.ScreenUpdating = False

Dim lngZeile As Long
Dim lngLetzte As Long
Dim arrSuch As Variant
Dim i As Long
Dim bAus As Boolean
Dim arrI As Variant
Dim strAUS As String, vntAUS As Variant
Dim rngAus As Range
Dim s As Long
Dim ZWB As Workbook
Dim ZWS As Worksheet
Dim Start As Double
Dim sval As String
Dim cel As Range

Set ZWB = ThisWorkbook ' Ziel: Workbook mit diesem Makro
Set ZWS = ZWB.Worksheets("Urlaub")
Start = Timer
GetMoreSpeed

If mblnEvent = True Then Exit Sub
mblnEvent = True

Tabelle21.Protect Password:=""
ZWB.Worksheets("Urlaub").Activate
Tabelle1.Range("B1:B15").ClearContents
s = ActiveCell.Column

' letzte Zeile in Spalte E ermitteln
lngLetzte = ZWS.Range("E:E").Find("*", ZWS.Range("E2"), xlValues, , xlByRows, xlPrevious).Row

' nun alle Zeilen in Spalte E ab Zeile 2 durchlaufen (Zeile 1 enthält Überschrift - ggf. anpassen)
arrI = ZWS.Range(ZWS.Cells(1, s), ZWS.Cells(lngLetzte, s)).Value

For Each cel In ZWS.Range(ZWS.Cells(45, s), ZWS.Cells(lngLetzte, s))
' Marker für Ausblenden auf wahr setzen
bAus = True
sval = cel.Value

' Schleife durch die Kriterien-Range in Tabelle1


For i = 1 To 12

'If Not IsNumeric(sval) And sval > "F" And sval > "U" And sval > "K" Then ' so geht es
If Not IsNumeric(sval) And sval > Tabelle1.Cells(1, 3).Value And sval > "U" And sval > "K" Then ' so nicht
'If Not IsNumeric(sval) And sval > Tabelle1.Cells(i, 3).Value Then
bAus = False
Exit For ' Abbruch der Schleife, sobald ein Kriterium erfüllt ist
End If
Next i




If bAus Then
If rngAus Is Nothing Then
Set rngAus = cel.EntireRow
Else
Set rngAus = Union(rngAus, cel.EntireRow)
End If
Else
strAUS = strAUS & "|" & cel.Value
End If
Next cel

If Not rngAus Is Nothing Then
rngAus.EntireRow.Hidden = True
'vntAUS = Split(Mid(strAUS, 2), "|")
'Tabelle1.Cells(1, 2).Resize(UBound(vntAUS) + 1) = Application.Transpose(vntAUS)
End If

ZWS.Range(ZWS.Cells(45, s), ZWS.Cells(lngLetzte, s)).SpecialCells(xlCellTypeVisible).Copy Destination:=Worksheets("Tabelle1").Range("B1")

GetMoreSpeed (0)
mblnEvent = False
MsgBox Format(Timer - Start, "#0.00") & " Sekunden gerödelt!"
End Sub


Kann mir jemand von euch dabei helfen?


mfg thomas