XL 2016 (Dé)sélection à partir d'un inputbox

[A1234]

Bonjour,

Je réalise une macro et j'aurai besoin de votre aide. J'essaie d'automatiser un filtrage sur la cellule Prev (H1) avec comme critères des numéros de 20 à 44.
J'aimerai garder tous les critères sauf un, celui qui est précisé par l'utilisateur grâce à un inputbox.

J'ai essayé le code suivant mais il bloque sur la partie c....

'a. Sélectionner toutes les versions
ActiveSheet.ListObjects("TableauData").Range.AutoFilter Field:=8
'b.Demander la version qui est à traiter
Dim num As Byte
num = InputBox("Inscrire le numéro de la version à traiter:")
'c. Déselectionner la famille à traiter
ActiveSheet.ListObjects("TableauData").Range.AutoFilter Field:=8, Criteria1 _
:=Array("<> *num* "), Operator:=xlFilterValues


merci d'avance

 

[mapomme]

Bonjour @A1234,

Essayer :

ActiveSheet.ListObjects("TableauData").Range.AutoFilter Field:=8, Criteria1:="<>" & num

 

[fanch55]

Bonjour,
Pour faire ce que décrivez :

Sub test()
    Dim Num: Num = InputBox("Inscrire le numéro de la version à traiter:")
    If Num <> "" Then [TableauData].AutoFilter Field:=8, Criteria1:="<>" & Num
End Sub

 

[A1234]

Bonjour,
Pour faire ce que décrivez :

Sub test()
    Dim Num: Num = InputBox("Inscrire le numéro de la version à traiter:")
    If Num <> "" Then [TableauData].AutoFilter Field:=8, Criteria1:="<>" & Num
End Sub

Bonjour merci pour votre retour,
Lorsque je test, votre code enlève toutes les sélections (numéros de 20 à 44) sur le filtre.... avez-vous une idée?

 

[mapomme]

Re,

Suite à votre remarque, je pense que nous avons mal compris votre question.
Si la colonne 8 est déjà filtrée, vous voulez conserver les critères de filtres actuels sauf celui saisi par l'utilisateur?
(si c'est cela, j'ai effectivement mal interprêté bien que c'était présent dans la question)
On s'y remet

 

[fanch55]

Si j'ai bien re-examiné la demande :
la colonne 8 du tableau est déjà filtrée avec une liste de valeurs .
vous désirez juste enlever une de celle-ci .....
C'est parti
Salut @mapomme

 

[A1234]

Re,

Suite à votre remarque, je pense que nous avons mal compris votre question.
Si la colonne 8 est déjà filtrée, vous voulez conserver les critères de filtres actuels sauf celui saisi par l'utilisateur?
(si c'est cela, j'ai effectivement mal interprêté bien que c'était présent dans la question)
On s'y remet

Re,
Oui c'est ça.
Par exemple dans la colonne H j'ai 20, 21, 22, 23, 24 et mon input me renvoie à 22 alors j'aimerai que le filtre ne prenne que 20, 21, 23, 24. Suis-je assez précise?

 

[fanch55]

Testez le code ci-dessous :

Sub Test()
Dim CritCur, CritNew As String
Dim Idx As Integer, J As Integer
Idx = 8
    With [Tableaudata].ListObject
        If .AutoFilter.FilterMode Then
            ReDim CritCur(1 To .AutoFilter.Filters(Idx).Count)
            Select Case UBound(CritCur)
                Case 1:    CritCur(1) = .AutoFilter.Filters(Idx).Criteria1
                Case 2:    CritCur(1) = .AutoFilter.Filters(Idx).Criteria1
                           CritCur(2) = .AutoFilter.Filters(Idx).Criteria2
                Case Else:    CritCur = .AutoFilter.Filters(Idx).Criteria1
            End Select
            
            Num = InputBox("Critères en cours:" & vbLf & _
                            Join(CritCur, vbTab) & vbLf & _
                            "Indiquez la valeur à exclure", _
                            .HeaderRowRange.Cells(Idx))
            
            If Num <> "" Then
                For J = 1 To UBound(CritCur)
                    If "=" & Num <> CritCur(J) _
                    Then CritNew = CritNew & Mid(CritCur(J), 2) & " "
                Next
                If CritNew = "" Then
                    .Range.AutoFilter Field:=Idx
                Else
                    .Range.AutoFilter Field:=Idx, Operator:=xlFilterValues, _
                           Criteria1:=Split(Trim(CritNew))
                End If
            End If
        End If
    End With
End Sub

 

[A1234]

J'ai une erreur d'exécution '1004' dès la ligne 7: ReDim CritCur(1 To .AutoFilter.Filters(Idx).Count)

 

[fanch55]

J'ai une erreur d'exécution '1004' dès la ligne 7: ReDim CritCur(1 To .AutoFilter.Filters(Idx).Count)

Je suis sur excel 2019 et je n'ai pas le problème

Testez le classeur ci-joint

 

[mapomme]

Re,

Une piste de tout autre nature dans le fichier joint.
On considère que les nombres affichés en colonne 8 sont issus de filtre de type sélection (cases cochées du filtre) - même si initialement d'autres filtres peuvent être actifs.

Sub FiltrerCol8()
Dim num As Long, dico, aux, x
 
With Sheets("Feuil1")
   num = Val(InputBox("Inscrire le numéro de la version à traiter:"))
   Set dico = CreateObject("scripting.dictionary")
   Set aux = .ListObjects("Tableau1").DataBodyRange.Columns(8)
   For Each x In aux.SpecialCells(xlCellTypeVisible): dico(CStr(x.Value)) = "": Next x
   If dico.exists(CStr(num)) Then dico.Remove CStr(CStr(num))
   .ListObjects("Tableau1").Range.AutoFilter Field:=8
   If dico.Count > 0 Then .ListObjects("Tableau1").Range.AutoFilter Field:=8, Criteria1:=dico.keys, Operator:=xlFilterValues
End With
End Sub

 

[fanch55]

Une piste dans le fichier joint. Ne sont conservés que les filtres de type "sélection".

Via dico, tu parcours toutes les lignes visibles, risque d'être long si grosse table ....
on peut rajouter les filtres en cours :

Option Explicit
Sub FiltrerCol8()
Dim num As Long, dico, aux, x
 
With Sheets("Feuil1")
   Set dico = CreateObject("scripting.dictionary")
   Set aux = .ListObjects("Tableau1").DataBodyRange.Columns(8)
   For Each x In aux.SpecialCells(xlCellTypeVisible): dico(CStr(x.Value)) = "": Next x
   num = Val(InputBox("Filtres en cours: " & vbLf & Join(dico.keys) & vbLf & "Inscrire le numéro de la version à ignorer:"))
   If dico.exists(CStr(num)) Then dico.Remove CStr(CStr(num))
   .ListObjects("Tableau1").Range.AutoFilter Field:=8
   If dico.Count > 0 Then .ListObjects("Tableau1").Range.AutoFilter Field:=8, Criteria1:=dico.keys, Operator:=xlFilterValues
End With
End Sub

Un petit souci quand même, si on fait annuler sur l'input, les valeurs 0 disparaissent ...

 

[patricktoulon]

bonjour à tous

Un petit souci quand même, si on fait annuler sur l'input, les valeurs 0 disparaissent ...

@fanch55 dans ce cas là tu fait un test strptr sur le return de l'input
un exemple comme ca vite fait

Sub test()
    a = Array(20, 21, 22, 23, 24)
    num = InputBox("Filtres en cours: " & vbLf & Join(a) & vbLf & "Inscrire le numéro de la version à ignorer:")
    If StrPtr(num) = 0 Then
        MsgBox "filtrage annulé !" & vbCrLf & "addressPtR : " & StrPtr(num)
    Else
        MsgBox "filtrage !" & vbCrLf & "addressPtR : " & StrPtr(num) & vbCrLf & "numero  à supprimer : " & Val(num) & _
               vbCrLf & Replace(Join(a), " " & num, "")
    End If
End Sub

il fait meme la différence entre 0 tapé et le 0 du strptr

maintenant tu sais comment on gère l’annulation d'un inputbox

 

[fanch55]

bonjour à tous

@fanch55 dans ce cas là tu fait un test strptr sur le return de l'input
un exemple comme ca vite fait
il fait meme la différence entre 0 tapé et le 0 du strptr

maintenant tu sais comment on gère l’annulation d'un inputbox

Ce n'est pas mon code mais je retiens l'astuce ...

 

[A1234]

Je suis sur excel 2019 et je n'ai pas le problème
Regarde la pièce jointe 1128759
Testez le classeur ci-joint

Bonjour, merci pour les précisions
Après différents tests j'ai compris que ça ne fonctionnait pas si on décoche pas une première cellule avant d'utiliser la formule. Et il y a aussi une autre limite, si le numéro écrit dans l'input box ne correspond pas au numéro de la BDD la macro tourne dans le vie