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

A1234 · 26 Janvier 2022

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 · 26 Janvier 2022

Bonjour @A1234,

Essayer :

Code:

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

fanch55 · 26 Janvier 2022

Bonjour,
Pour faire ce que décrivez :

VB:

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 · 26 Janvier 2022

fanch55 à dit:
Bonjour,
Pour faire ce que décrivez :

VB:

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 · 26 Janvier 2022

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 · 26 Janvier 2022

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 · 26 Janvier 2022

mapomme à dit:
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 · 26 Janvier 2022

Testez le code ci-dessous :

VB:

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 · 26 Janvier 2022

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

fanch55 · 26 Janvier 2022

A1234 à dit:
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 · 26 Janvier 2022

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.

VB:

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 · 26 Janvier 2022

mapomme à dit:
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 :

VB:

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 · 26 Janvier 2022

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

VB:

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 · 26 Janvier 2022

patricktoulon à dit:
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 · 27 Janvier 2022

fanch55 à dit:
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

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

A1234

XLDnaute Nouveau

mapomme

XLDnaute Barbatruc

fanch55

XLDnaute Barbatruc

A1234

XLDnaute Nouveau

mapomme

XLDnaute Barbatruc

fanch55

XLDnaute Barbatruc

A1234

XLDnaute Nouveau

fanch55

XLDnaute Barbatruc

A1234

XLDnaute Nouveau

fanch55

XLDnaute Barbatruc

Pièces jointes

mapomme

XLDnaute Barbatruc

Pièces jointes

fanch55

XLDnaute Barbatruc

patricktoulon

XLDnaute Barbatruc

fanch55

XLDnaute Barbatruc

A1234

XLDnaute Nouveau

Discussions similaires