Live-Forum - Die aktuellen Beiträge
Datum
Titel
28.03.2024 21:12:36
28.03.2024 18:31:49
Anzeige
Archiv - Navigation
1544to1548
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

Mehr als 2 Kriterien auslesen

Mehr als 2 Kriterien auslesen
10.03.2017 13:30:07
corpix
Hallo Fachexperten aus aller Welt :-)
Mein Problem bringt euch hoffentlich zum Lachen... ich könnte heulen....
Also.. Ich hab auf meinem Tabellenblatt mehrere Filter gesetzt. Ich hab des weitere noch ne Tabelle in einer Tabelle und ein Doppelfilter usw. usw. leider bin ich nicht in der Lage das richtig zu erklären....
Mit jeder Lösung die ich gefunden habe ist es meist leider nur möglich zwei Kriterien aus einem Filter auszulesen. Beim dritten oder oft auch schon beim zweiten gibt es eine Fehlermeldung oder ist auf Grund des Codes nicht möglich.
Ich hätte sehr gerne eine Schleife mit einer Variablen Variable (ich weis wie dumm sich das anhört). Das Programm sollte erkennen wie viele Kriterien gesetzt sind und dementsprechend diese in einem anderen Tabellenblatt untereinander auflisten.
Das ihr seht wie unfähig ich bin hänge ich euch jetzt den Codeschnipsel an:
Option Explicit
Sub Haupt()
Dim intRow, Var As Integer
Dim x As Byte
Dim intSpalte As Integer
Dim strFilter As String
Dim wksBlatt As Worksheet
Dim wksFilter1 As Worksheet
Dim wksFilter2 As Worksheet
Set wksBlatt = Worksheets("SAPExport")
Var = 27 ' Bei 28 fängt die Tabelle an in die ich es eintragen möchte
If wksBlatt.AutoFilterMode Then
With wksBlatt.AutoFilter
For intSpalte = 1 To .Filters.Count
Var = Var + 1
With .Filters.Item(intSpalte)
If .On Then
x = 1
If .Operator Then
Sheets("Merkmale").Cells(x + 1, Var) = .Criteria1
x = x + 1
Sheets("Merkmale").Cells(x + 1, Var) = .Criteria2
x = x + 1
' Mit mehr als 2 ist es nicht möglich oder gibt dann halt ne Fehlermeldung....   _
_
mit On Error hab ich´es auch nicht hinbekommen....
Else
Sheets("Merkmale").Cells(x + 1, Var) = .Criteria1
End If
Else
End If
End With
Next
End With
End If
End Sub

Bitte erleuchtet mich ihr VBA - Götter

2
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Mehr als 2 Kriterien auslesen
12.03.2017 22:11:42
fcs
Hallo corpix,
fur einen korrekten Ablauf muss man alle Filteroperatoren auswerten.
Gruß
Franz
Sub Haupt()
Dim intRow, Var As Integer
Dim x As Byte
Dim intSpalte As Integer
Dim strFilter As String
Dim wksBlatt As Worksheet
Dim wksFilter1 As Worksheet
Dim wksFilter2 As Worksheet
Dim varItem
Set wksBlatt = Worksheets("SAPExport")
Var = 27 ' Bei 28 fängt die Tabelle an in die ich es eintragen möchte
If wksBlatt.AutoFilterMode Then
With wksBlatt.AutoFilter
For intSpalte = 1 To .Filters.Count
Var = Var + 1
With .Filters.Item(intSpalte)
If .On Then
x = 1
Select Case .Operator
Case 0 'Einzelwert
Sheets("Merkmale").Cells(x + 1, Var).Value = "'" & .Criteria1
Case 1 'xlAnd - Logisches UND zwischen Kriterium1 und Kriterium2
Sheets("Merkmale").Cells(x + 1, Var) = "'" & .Criteria1
x = x + 1
Sheets("Merkmale").Cells(x + 1, Var) = "UND"
x = x + 1
Sheets("Merkmale").Cells(x + 1, Var) = "'" & .Criteria2
Case 2 'xlOr 2 Logisches ODER zwischen Kriterium1 und Kriterium2
Sheets("Merkmale").Cells(x + 1, Var) = "'" & .Criteria1
x = x + 1
Sheets("Merkmale").Cells(x + 1, Var) = "ODER"
x = x + 1
Sheets("Merkmale").Cells(x + 1, Var) = "'" & .Criteria2
Case 3 'xlTop10Items - Die Einträge mit dem höchsten Wert werden angezeigt
Sheets("Merkmale").Cells(x + 1, Var).Value = "TOP 10"
x = x + 1
Sheets("Merkmale").Cells(x + 1, Var) = "'" & .Criteria1
Case 4 'xlBottom10Items - Die Einträge mit dem niedrigsten Wert werden  _
angezeigt
Sheets("Merkmale").Cells(x + 1, Var).Value = "Bottom 10"
x = x + 1
Sheets("Merkmale").Cells(x + 1, Var) = "'" & .Criteria1
Case 5 'xlTop10Percent  - Die Einträge mit dem höchsten Wert werden angezeigt
Sheets("Merkmale").Cells(x + 1, Var).Value = "TOP 10%"
x = x + 1
Sheets("Merkmale").Cells(x + 1, Var) = "'" & .Criteria1
Case 6 'xlBottom10Percent - Die Einträge mit dem niedrigsten Wert werden  _
angezeigt
Sheets("Merkmale").Cells(x + 1, Var).Value = "Bottom 10%"
x = x + 1
Sheets("Merkmale").Cells(x + 1, Var) = "'" & .Criteria1
Case 7 ' Filterliste
For Each varItem In .Criteria1
Sheets("Merkmale").Cells(x + 1, Var).Value = "'" & varItem
x = x + 1
Next
Case 8 'xlFilterCellColor - Farbe der Zelle
Sheets("Merkmale").Cells(x + 1, Var).Value = "Zellfarbe"
Case 9 'xlFilterFontColor - Farbe der Schriftart
Sheets("Merkmale").Cells(x + 1, Var).Value = "Schriftfarbe"
Case 10 'xlFilterIcon - Filtersymbol
Sheets("Merkmale").Cells(x + 1, Var).Value = "Symbol"
Case 11 'xlFilterDynamic - Dynamischer Filter
Sheets("Merkmale").Cells(x + 1, Var).Value = "dynamisch"
x = x + 1
Select Case .Criteria1
Case 33
Sheets("Merkmale").Cells(x + 1, Var) = "über Durchschnitt"
Case 34
Sheets("Merkmale").Cells(x + 1, Var) = "unter Durchschnitt"
End Select
Case Else
'do nothing
Sheets("Merkmale").Cells(x + 1, Var) = "unbekannter Filtertyp"
End Select
Else
End If
End With
Next
End With
End If
End Sub

Anzeige
AW: Mehr als 2 Kriterien auslesen
13.03.2017 07:27:54
corpix
Der Text funktioniert super :-)
Ich möchte an dieser Stelle ein unglaublich großes Dankeschön aussprechen :-)

305 Forumthreads zu ähnlichen Themen

Anzeige
Anzeige
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige