Thema Datum  Von Nutzer Rating
Antwort
Rot Autofilter mit mehreren Enthält-Kriterien Funktioniert nicht
06.07.2021 16:40:26 Bernd
NotSolved
06.07.2021 17:11:56 Gast15772
NotSolved
06.07.2021 17:12:47 Mase
NotSolved
07.07.2021 10:05:05 Bernd
NotSolved
07.07.2021 12:02:39 Bernd
NotSolved
07.07.2021 12:16:48 Mase
NotSolved
07.07.2021 14:36:20 Bernd
NotSolved
07.07.2021 15:05:49 Mase
NotSolved
07.07.2021 15:47:19 Bernd
NotSolved
07.07.2021 16:18:58 Mase
NotSolved
08.07.2021 11:33:03 Bernd
NotSolved
06.07.2021 17:21:20 Gast7777
NotSolved

Ansicht des Beitrags:
Von:
Bernd
Datum:
06.07.2021 16:40:26
Views:
85
Rating: Antwort:
  Ja
Thema:
Autofilter mit mehreren Enthält-Kriterien Funktioniert nicht

Hallo,

Ich habe jetzt bereits mehrere Versionen versucht, aber ich bekomme es einfach nicht zum Laufen. 

Auch bei der Forensuche stoße ich immer wieder auf die üblichen Verdächtigen, die bei mir nicht laufen.

Ich nehme an es liegt an den Sternchen, bekomme aber zumindest bei einigen Varianten einen Wert (der Letzte) raus.

 

Von Vorne:

Ich habe in der Spalte "B" einen Text

Dieser könnte so aussehen:

Gefahrenmeldung (Life Safety).BI12
Gefahrenmeldung (Property Safty).BI13
Co Messung.AI3
Alarmmeldung BV102
Wartungsmeldung Filter AV110
Wartungsschalter.EV5
Betriebsmeldungen.BA15

Nun muss ich über VBA Die Kriterien .BI, .AI, .BV und .AV ausfiltern. 

Dies habe ich am anfang nur mit "*.BI*" und "*.AI*" mit dem "Normalen Autofilter" und Operator:=xlOr gemacht und es hatte sehr gut geklappt.

Bis die beiden Kriterien BV und AV dazu kamen.

 

Jetzt habe ich einen neuen Code gebraucht.

Also nachgelesen und auf Array gekommen.

ActiveSheet.Range("$A$1:K" & loLetzte).Autofilter Field:=2, Criteria1:=Array("*.AI*", "*.BI*", "*.AV*", "*.BV*"), Operator:=xlFilterValues

= 0 Ergebnisse


ActiveSheet.Range("$A$1:K" & loLetzte).Autofilter Field:=2, Criteria1:=Array("*.AI*", "*.BI*", "*.AV*", "*.BV*"), Operator:=xlOr

= 1 Treffer mit BV

Also einen längeren Code genommen, der im endeffekt die Gleiche Funktion nutzt, aber alles über Variablen

 


    '** Autofilter mit mehreren Kriterien in Spalte B setzen
    '** Dimensionierung der Variablen
    Dim rngFilterRange As Range
    Dim lngCriteriaCount As Long
    Dim arrCriteria() As String
    '** Anzahl der Kriterien festlegen
    lngCriteriaCount = 4
    '** Variable neu dimensionieren da die Criterial mit 0 beginnen
ReDim arrCriteria(0 To lngCriteriaCount - 1)
    '** Filterkriterien festlegen

arrCriteria(0) = "*.AI*"
arrCriteria(1) = "*.BI*"
arrCriteria(2) = "*.AV*"
arrCriteria(3) = "*.BV*"
    
 '** Objektvariable setzen

Set rngFilterRange = ActiveSheet.Range("A1:K" & loLetzte)

 '** Autofilter setzen/ausführen

rngFilterRange.Autofilter Field:=2, Criteria1:=arrCriteria(), Operator:=xlOr
    
    
' Filtern nach AI und BI (Analog und Digital input und Virtuelle Analog und Digitale Werte)

ActiveSheet.Range("$A$1:K" & loLetzte).Autofilter Field:=2, Criteria1:=Array("*.AI*", "*.BI*", "*.AV*", "*.BV*"), Operator:=xlFilterValues
 

Gleiches Ergebniss (0 Treffer, mit Operator:=xlOr letzter Treffer)

 

Also einen ganz anderen Code, den ich nicht aufdröseln konnte:

Dim arr1, arr2
Dim Z As Long
arr1 = Range("B1:B100").Value
ReDim arr2(1 To UBound(arr1, 1)) As String
For Z = 2 To UBound(arr1)
    Select Case arr1(Z, 1)
        Case "*.AI*", "*.BI*", "*.AV*", "*.BV*"
        Case Else
            arr2(Z) = CStr(arr1(Z, 1))
    End Select
Next
Range("$B$1:$B$100").Autofilter Field:=2, Criteria1:=arr2, Operator:=xlFilterValues

Der hat mir überhaupt nichts gefiltert und mit Operator:=xlOr alles herausgefiltert

 

Es muss doch möglich sein mit VBA vier "Enthält" Kriterien zu Filtern. Zwei funktionieren doch auch.

 

Im Endeffekt möchte ich die gefilterten Zeilen in ein neues Tabellenblatt kopieren, nachdem ich in Spalte J nach 31 oder 61 gesucht habe.

Also: Wenn "B" = ("*.AI*"or "*.BI*"or "*.AV*"or "*.BV*") und ("J" = 31 or 61) dann Kopiere nach neues Sheet 

Wenn es Funktioniert mit dem Filtern, habe ich es auch hinbekommen.

 

' Name des neuen Sheet muss auf 31 Zeichen gekürzt werden
Dim Ort31 As String
Ort31 = Left(Ort, 31)
 'Neues Sheet erstellen und mit Namen versehen
 Worksheets.Add.Name = Ort31

 ' Nach Notivication Class 31 und 61 suchen und in neues Sheet Kopieren
  
  Dim Kopierange As Range
  Dim SuchZeile As Long


 ' Nach 31 suchen
 'Letzte Zeile feststellen
 With Worksheets(QSheet.Name)
    loLetzte = .Cells(.Rows.Count, "A").End(xlUp).Row
End With
With Worksheets(QSheet.Name)
Set Kopierange = .Rows(1)
For SuchZeile = 1 To loLetzte
If .Cells(SuchZeile, 10).Value = 31 Then
Set Kopierange = Union(Kopierange, .Rows(SuchZeile))
End If
Next SuchZeile
'Kopierange.Copy Destination:=Worksheets(Ort31).Range("A1")
End With

 ' Nach 61 suchen

With Worksheets(QSheet.Name)

For SuchZeile = 1 To loLetzte
If .Cells(SuchZeile, 10).Value = 61 Then
Set Kopierange = Union(Kopierange, .Rows(SuchZeile))
End If
Next SuchZeile
Kopierange.Copy Destination:=Worksheets(Ort31).Range("A1")

End With

 

Ich hoffe ich habe euch nicht zu sehr verwirrt, Wollte aber Zeigen, das ich durchaus nach einer Lösung gesucht habe.

 

Danke


Ihre Antwort
  • Bitte beschreiben Sie Ihr Problem möglichst ausführlich. (Wichtige Info z.B.: Office Version, Betriebssystem, Wo genau kommen Sie nicht weiter)
  • Bitte helfen Sie ebenfalls wenn Ihnen geholfen werden konnte und markieren Sie Ihre Anfrage als erledigt (Klick auf Häckchen)
  • Bei Crossposting, entsprechende Links auf andere Forenbeiträge beifügen / nachtragen
  • Codeschnipsel am besten über den Code-Button im Text-Editor einfügen
  • Die Angabe der Emailadresse ist freiwillig und wird nur verwendet, um Sie bei Antworten auf Ihren Beitrag zu benachrichtigen
Thema: Name: Email:

 
 

  • Bitte beschreiben Sie Ihr Problem möglichst ausführlich. (Wichtige Info z.B.: Office Version, Betriebssystem, Wo genau kommen Sie nicht weiter)
  • Bitte helfen Sie ebenfalls wenn Ihnen geholfen werden konnte und markieren Sie Ihre Anfrage als erledigt (Klick auf Häckchen)
  • Bei Crossposting, entsprechende Links auf andere Forenbeiträge beifügen / nachtragen
  • Codeschnipsel am besten über den Code-Button im Text-Editor einfügen
  • Die Angabe der Emailadresse ist freiwillig und wird nur verwendet, um Sie bei Antworten auf Ihren Beitrag zu benachrichtigen

Thema Datum  Von Nutzer Rating
Antwort
Rot Autofilter mit mehreren Enthält-Kriterien Funktioniert nicht
06.07.2021 16:40:26 Bernd
NotSolved
06.07.2021 17:11:56 Gast15772
NotSolved
06.07.2021 17:12:47 Mase
NotSolved
07.07.2021 10:05:05 Bernd
NotSolved
07.07.2021 12:02:39 Bernd
NotSolved
07.07.2021 12:16:48 Mase
NotSolved
07.07.2021 14:36:20 Bernd
NotSolved
07.07.2021 15:05:49 Mase
NotSolved
07.07.2021 15:47:19 Bernd
NotSolved
07.07.2021 16:18:58 Mase
NotSolved
08.07.2021 11:33:03 Bernd
NotSolved
06.07.2021 17:21:20 Gast7777
NotSolved