XL 2010 Utilisation de filtre avec ARRAY (liste d'exceptions)

[g.milano]

Bonjour,

D'habitude je fais cela qui marche très bien (items a sélectionner listés avec une array) :

Sub 店舗返却リスト()

    Dim CSV As Workbook
    Dim panel As Worksheet
    Dim deetaa As Range
    tenpo = Array("1F GUARDAROBA", "2F CAFE", "3F STORE", "5F 家具ショールーム") _
    hanbai = Array("楽天", "自社サイト", "BUYMA", "AMAZON", "eBay", "ポンパレ", "11Concept", "ORIGAMI", "ヤフPeppiNo") '"ヤフオク１円", "ヤフオク定額"

    Application.ScreenUpdating = False

    Set CSV = Workbooks.Open("C:\#\Database\返却分.CSV")
    Set panel = CSV.Sheets("返却分")
    Set deetaa = panel.UsedRange
    Range("A2").Select
    ActiveWindow.FreezePanes = True
    With deetaa
        .AutoFilter Field:=4, Criteria1:=tenpo, Operator:=xlFilterValues
        .AutoFilter Field:=5, Criteria1:=hanbai, Operator:=xlFilterValues
        .AutoFilter Field:=6, Criteria1:="<>*見?からなかった*", Operator:=xlAnd, Criteria2:="<>*発送済み*"
        .Columns("A:G").EntireColumn.AutoFit
        .Columns("H").ColumnWidth = 29
        .SpecialCells(xlCellTypeVisible).Copy
    End With

Mais dans un des filtres (AutoFilter Field:=6), je voudrais non pas une liste de sélection, mais une liste d'exceptions (toutes les valeurs SAUF quelques unes). Comme on est limité dans les Criteria1:= , j'ai essayé avec cette écriture (qui me semblait logique), mais qui ne fonctionne pas.

reigai = Array("<>*見付からなかった*", "<>*直し*", "<>*発送済み*", "<>*貸し出し*")
(...)
.AutoFilter Field:=6, Criteria1:=reigai, Operator:=xlFilterValues

Mes recherches sur le net n'ont pas abouti non plus.
Est-il possible d'utiliser une Array pour ce genre de sélection ? Si oui, comment s'y prendre ? Sinon, connaitriez-vous un autre moyen ?


Merci pour votre aide m(_ _)m

 

[Bebere]

Re : Utilisation de filtre avec ARRAY (liste d'exceptions)

bonjour g.milano
bienvenue
trouvé ce code,pas le temps d'en faire plus pour le moment

Sub Main()
Dim a As String
Dim B As String
Dim C As String
Dim filterCriteria as Variant
a = "=*an*"
B = Empty
C = "=*ap*"
filterCriteria = CombineArrays(Array(a, B, C))

If Not uBound(filterCriteria) = -1 Then

Range("A1").Select
ActiveSheet.Range("A1:A5").AutoFilter Field:=1, _
Criteria1:=filterCriteria, Operator:=xlFilterValues

End If
End Sub

Function CombineArrays(arr As Variant) As Variant
Dim a As Variant
Dim filterDic As Object 'Scripting.Dictionary
Set filterDic = CreateObject("Scripting.Dictionary")

For Each a In arr
If Not filterDic.Exists(a) And Not a = vbNullString Then
filterDic.Add a, a
End If
Next

CombineArrays = filterDic.Keys

Set filterDic = Nothing
End Function