Kriterium Autofilter variabel auslesen & einsetzen

Hallo Forumsmitglieder,
ich habe da ein Problem - für Euch wird es sicherlich einfach sein.
Folgender Sachverhalt. Ich habe eine Excel-Liste, in der bestimmte Werte in einer bestimmten Spalte mit "nein" gesetzt werden sollen. Dafür habe ich Makro übernommen, dass ich nachpflege.
Ich habe eine sehr fehleranfällige Lösung übernommen: Für jedes Element habe ich nachfolgenden Quellcode (als Beispiel für das 436. Kriterium):
Selection.AutoFilter Field:=1, Criteria1:="KRITERIUM436"
Range("A1").Select
'Abfrage, wieviele Datensätze im Autofilter stehen
'Anzahl aller angezeigten Zellen (nicht Zeilen) im Autofilter einschließlich Kopfzeile
x = Application.WorksheetFunction.Subtotal(3, ActiveSheet.AutoFilter.Range)
'Anzahl der Spalten im Autofilter
y = ActiveSheet.AutoFilter.Filters.Count
'Anzahl der Zeilen im Autofilter (ohne Kopfzeile)
z = ((x / y) - 1)
If z > 0 Then
Dim iRow63tub436 As Integer, iRowT63tub436 As Integer
iRow63tub436 = 3
Do Until IsEmpty(Cells(iRow63tub436, 1))
If Rows(iRow63tub436).Hidden = False Then
iRowT63tub436 = iRow63tub436
Exit Do
End If
iRow63tub436 = iRow63tub436 + 1
Loop
Range("H" & iRowT63tub436).Select
ActiveCell.FormulaR1C1 = "nein"
End If
Selection.AutoFilter Field:=1
Ich möchte jedoch, dass ich nicht bei jedem neuen Element den oben genannte Code kopiere, das Kriterium anpasse und die Variable "63tub436" um eins erhöhe bzw. wenn ein Papier nicht mehr in der Liste ist, den Code löschen.
Vielmehr möchte ich, dass ich auf einem neuen Blatt (Name z.B. "Nein") in der Datei diejenigen Kriterien definieren, die auf dem ersten Sheet auf "nein"gesetzt werden sollen. Hierdurch wird natürlich das Code wesentlich kürzer, da oben genannter Code nur noch einmal genutzt wird.
Jetzt komme ich zu dem Problem, dass ich das ganze übernommen habe und nicht so viel Ahnung davon habe. Was muss ich um dieses VBA drumbauen und umbauen, dass ich mittels einer do-loop (oder so?) die Kriterien auf dem neuen Blatt "Nein" Datensatz um Datensatz auslese, den Filter auf dem Blatt "Details" entsprechend setze und dann in der entsprechenden Zelle ein "nein" reinschreibe. Und das Makro solange läuft, bis eine leere Zeile kommt.
Hoffe auf einen Tipp / eine Lösung von Euch.
Danke & Grüße
bjoern

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Hallo Bjoern,
Hier mal ein paar Varianten, wobei man meiner Meinung nach das Ganze auch ohne Autofilter lösen kann, nämlich mit der Suchen-Methode.
Die kriterien trägst du für meine Vorschläge im Blatt "Nein" in Spalte A ab Zeile 1 ein.
Ob du die Variante mit den Arrays benötigst, hängt davon ab, ob du die Nummern der gefundenen Zeilen noch irgendwie weiterverarbeiten muss.
Gruß
Franz


Sub NeinKriterien()
'Kriterien Filtern und speichern der geänderten Zeilen in einem Array. _
Anzeige der Kriterien und zeilen in einer MsgBox.
Dim wksNein As Worksheet, lngNein As Long, varKriterium As Variant
Dim wksDetail As Worksheet, lngDetail As Long
Dim intKrit, arrKriterium() As String, arrRow63tub() As Long, arrRowT63tub() As Long
Dim x As Long, strMsg As String
Set wksNein = Worksheets("Nein")
Set wksDetail = Worksheets("Details")
wksDetail.Activate
With wksNein
'Zeilen mit Kriterien im Blatt "nein" abarbeiten
For lngNein = 2 To .Cells(.Rows.Count, 1).End(xlUp).Row
varKriterium = .Cells(lngNein, 1).Value
intKrit = intKrit + 1
ReDim Preserve arrKriterium(1 To intKrit)
arrKriterium(intKrit) = varKriterium
ReDim Preserve arrRow63tub(1 To intKrit)
ReDim Preserve arrRowT63tub(1 To intKrit)
Selection.AutoFilter Field:=1, Criteria1:=varKriterium
Range("A1").Select
'Abfrage, wieviele Datensätze im Autofilter stehen
'Anzahl aller angezeigten Zeilen im Autofilter einschließlich Kopfzeile
x = Application.WorksheetFunction.Subtotal(3, ActiveSheet.AutoFilter.Range.Columns(1))
If x > 1 Then 'mindestens eine Datenzeile wird angezeigt
arrRow63tub(intKrit) = 3 'Nummer der Zeile unter Autofilter-Titelzeile
Do Until IsEmpty(Cells(arrRow63tub(intKrit), 1))
If Rows(arrRow63tub(intKrit)).Hidden = False Then
arrRowT63tub(intKrit) = arrRow63tub(intKrit)
Exit Do
End If
arrRow63tub(intKrit) = arrRow63tub(intKrit) + 1
Loop
If arrRowT63tub(intKrit) > 0 Then
Cells(arrRowT63tub(intKrit), 8).Value = "nein" 'Spalte H
End If
End If
Selection.AutoFilter Field:=1
Next
End With
'Änderungen in MsgBox anzeigen
strMsg = "Kriterium    -     Zeile"
For lngNein = 1 To intKrit
strMsg = strMsg & vbLf & arrKriterium(lngNein) & "   -   " & arrRowT63tub(lngNein)
If lngNein Mod 20 = 0 Then
MsgBox strMsg
strMsg = "Kriterium    -     Zeile"
End If
Next
If strMsg  "Kriterium    -     Zeile" Then
MsgBox strMsg, vbOKOnly, "Kriterien mit Nein"
End If
End Sub
Sub NeinKriterien_ohneFelder()
'Kriterien Filtern und markieren ohne Speichern der geänderten Zeilen
Dim wksNein As Worksheet, lngNein As Long, varKriterium As Variant
Dim wksDetail As Worksheet, lngDetail As Long
Dim arrRow63tub As Long, arrRowT63tub As Long
Dim x As Long
Set wksNein = Worksheets("Nein")
Set wksDetail = Worksheets("Details")
wksDetail.Activate
Application.ScreenUpdating = False
With wksNein
'Zeilen mit Kriterien im Blatt "nein" abarbeiten
For lngNein = 2 To .Cells(.Rows.Count, 1).End(xlUp).Row
varKriterium = .Cells(lngNein, 1).Value
arrRowT63tub = 0 'Trefferzeile zurücksetzen
Selection.AutoFilter Field:=1, Criteria1:=varKriterium
Range("A1").Select
'Abfrage, wieviele Datensätze im Autofilter stehen
'Anzahl aller angezeigten Zeilen im Autofilter einschließlich Kopfzeile
x = Application.WorksheetFunction.Subtotal(3, ActiveSheet.AutoFilter.Range.Columns(1))
If x > 1 Then 'mindestens eine Datenzeile wird angezeigt
arrRow63tub = 3 'Nummer der Zeile unter Autofilter-Titelzeile
Do Until IsEmpty(Cells(arrRow63tub, 1))
If Rows(arrRow63tub).Hidden = False Then
arrRowT63tub = arrRow63tub
Exit Do
End If
arrRow63tub = arrRow63tub + 1
Loop
If arrRowT63tub > 0 Then
Cells(arrRowT63tub, 8).Value = "nein" 'Spalte H
End If
End If
Selection.AutoFilter Field:=1
Next
End With
Application.ScreenUpdating = True
End Sub
Sub NeinKriterien_Suchen()
'Nein-Kriterien markieren ohne Autofilter setzen.
'Jeweils die alle Fundstellen in Spalte 1 werden auf "nein" gesetzt
Dim wksNein As Worksheet, lngNein As Long, varKriterium As Variant
Dim wksDetail As Worksheet, rngGefunden As Range, strAdresse
Set wksNein = Worksheets("Nein")
Set wksDetail = Worksheets("Details")
wksDetail.Activate
Application.ScreenUpdating = False
With wksNein
'Zeilen mit Kriterien im Blatt "nein" abarbeiten
For lngNein = 2 To .Cells(.Rows.Count, 1).End(xlUp).Row
varKriterium = .Cells(lngNein, 1).Value
With wksDetail
Set rngGefunden = .Columns(1).Find(What:=varKriterium, LookIn:=xlValues, _
lookat:=xlWhole)
If rngGefunden Is Nothing Then
MsgBox varKriterium & "  nicht im Blatt Details Spalte 1 gefunden!"
Else
strAdresse = rngGefunden.Address ' 1. Fundstelle merken
Do
.Cells(rngGefunden.Row, 8).Value = "nein" 'Spalte H
Set rngGefunden = .Columns.FindNext(after:=rngGefunden)
Loop Until rngGefunden.Address = strAdresse
End If
End With
Next
End With
Application.ScreenUpdating = True
End Sub

Beliebteste Forumthreads (12 Monate)

Kriterium Autofilter variabel auslesen & einsetzen

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

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

3
Beiträge zum Forumthread

Beiträge zu diesem Forumthread