Bei Klick CommandButton filtern nach Liste
09.10.2017 11:01:47
Kati
ich möchte über einen Klick auf den CommandButton immer den nächsten Wert in einer Filterung anzeigen lassen. Ab der Filterung 30 überspringt dieser einige Werte und filtert auf 711. Es gibt auch eine Liste in einem anderen Tabellenblatt um dem Array zu füllen. Könnt ihr mir helfen?
Option Explicit
Sub filtern()
Dim wks As Worksheet
Set wks = ActiveSheet
With wks
If .AutoFilterMode = True Then GoTo weiter:
End With
Dim g As Integer
Dim gewerke()
gewerke = Array("01", "02", "03", "04", "05", "06", "07", "08", "09", "10", "11", "12", "13", "14", "15", "16", "17", "18", "19", "20", "21", "30", "40", "50", "60", "70", "1000", "100", "700", "710", "711", "712", "713", "719", "720", "721", "722", "723", "724", "725", "729", "730", "731", "732", "733", "734", "735", "736", "739", "740", "741", "742", "743", "744", "745", "746", "747", "748", "749", "750", "751", "752", "759", "760", "761", "762", "763", "769", "770", "771", "772", "773", "774", "775", "779", "790", "811", "821", "831", "841", "851", "861", "862", "871")
For g = 0 To UBound(gewerke)
Sheets("Vergabe").Activate
ActiveSheet.Range("A1:a5362").AutoFilter Field:=1, Criteria1:=gewerke(g), Operator:=xlAnd
Next g
weiter: Call nächstefilterung
End Sub
Private Sub nächstefilterung()
Dim Variable As Variant
Dim g As Variant
Dim Ergebnis As Integer
Dim gewerke()
gewerke = Array("01", "02", "03", "04", "05", "06", "07", "08", "09", "10", "11", "12", "13", " _
_
14", "15", "16", "17", "18", "19", "20", "21", "30", "40", "50", "60", "70", "1000", "100", " _
700", "710", "711", "712", "713", "719", "720", "721", "722", "723", "724", "725", "729", "730", "731", "732", "733", "734", "735", "736", "739", "740", "741", "742", "743", "744", "745", "746", "747", "748", "749", "750", "751", "752", "759", "760", "761", "762", "763", "769", "770", "771", "772", "773", "774", "775", "779", "790", "811", "821", "831", "841", "851", "861", "862", "871")
Dim c1 As String
With Worksheets(1)
If .AutoFilterMode Then
With .AutoFilter.Filters(1)
If .On Then c1 = .Criteria1
End With
End If
End With
Range("E1").Value = "" & c1
g = Range("E1").Value
Sheets("Vergabe").Activate
ActiveSheet.Range("A1:a5362").AutoFilter Field:=1, Criteria1:=gewerke(g), Operator:=xlAnd
'Range("E1").ClearContents
End Sub
Anzeige