Remplacer la liste de choix d'un array par une variable
Bonjour,
Je ne suis pas sûr de la justesse des termes employés dans ma demande...
Est-il possible d'utiliser une variable pour alimenter un array ?
Dans le cas où ce serait possible, j'ai fait pas mal d'essais, mais je n'ai pour l'instant pas trouvé la bonne syntaxe.
Je joins un fichier que j'ai réduit, mais qui est fonctionnel.
La partie concernée est celle-ci :
ActiveSheet.ListObjects("Tableau2").Range.AutoFilter Field:=4, Criteria1:=Array(NomSociete2), Operator:=xlFilterValues
Elle est sensée remplacer cette ligne :
ActiveSheet.ListObjects("Tableau2").Range.AutoFilter Field:=4, Criteria1:= _
Array("DEAL", "DREAL", "DRIEE", "DTAM", "DD(CS)PP", "DDPP", "DDCSPP", "OFB", "ET4", "ET3", "MNHN"), Operator:=xlFilterValues
Code complet :
Sub Filtre_Administration_2()
'Filtre sur administrations
Dim i As Integer
Dim NomSociete As String, NomSociete2 As String
Set WsL = Worksheets("Listes")
Application.ScreenUpdating = False
Application.Calculation = xlManual
For i = 2 To 9
NomSociete = """" & WsL.Range("J" & i) '& NomSociete '.Value
NomSociete2 = NomSociete2 & NomSociete & """, "
Next i
NomSociete2 = Left(NomSociete2, Len(NomSociete2) - 2)
'ActiveSheet.ListObjects("Tableau2").Range.AutoFilter Field:=4, Criteria1:= _
Array("DEAL", "DREAL", "DRIEE", "DTAM", "DD(CS)PP", "DDPP", "DDCSPP", "OFB", "ET4", "ET3", "MNHN"), Operator:=xlFilterValues
MsgBox NomSociete2
ActiveSheet.ListObjects("Tableau2").Range.AutoFilter Field:=4, Criteria1:=Array(NomSociete2), Operator:=xlFilterValues
Application.Goto Range("F4"), True
Application.Calculation = xlAutomatic
Application.ScreenUpdating = True
End Sub
Merci d'avance pour les conseils et l'aide apportée.
Bonne journée
Dan
Bonjour,
proposition de correction
Sub Filtre_Administration_2()
'Filtre sur administrations
Dim i As Integer
Dim NomSociete As String, NomSociete2 As String
Set WsL = Worksheets("Listes")
Application.ScreenUpdating = False
Application.Calculation = xlManual
For i = 2 To 9
NomSociete = NomSociete & WsL.Range("J" & i) & "," '& NomSociete '.Value
Next i
NomSociete = Left(NomSociete, Len(NomSociete) - 1)
'ActiveSheet.ListObjects("Tableau2").Range.AutoFilter Field:=4, Criteria1:= _
Array("DEAL", "DREAL", "DRIEE", "DTAM", "DD(CS)PP", "DDPP", "DDCSPP", "OFB", "ET4", "ET3", "MNHN"), Operator:=xlFilterValues
MsgBox NomSociete
ActiveSheet.ListObjects("Tableau2").Range.AutoFilter Field:=4, Criteria1:=Split(NomSociete, ","), Operator:=xlFilterValues
Application.Goto Range("F4"), True
Application.Calculation = xlAutomatic
Application.ScreenUpdating = True
End Sub
Bonjour,
Pouvez-vous essayer ceci :
dim arrSociete2 as variant
'code
arrSociete2 = application.transpose(WsL.Range("J2:J9"))
ActiveSheet.ListObjects("Tableau2").Range.AutoFilter Field:=4, Criteria1:=arrSociete2, Operator:=xlFilterValues
Cdlt,
Bonjour,
Merci beaucoup à vous 2 pour vos réponses rapides et qui fonctionnent très bien.
Je m'embêtais à ajouter des guillemets autours des différentes valeurs pour rien, puisque non nécessaires.
La proposition de 3GB est sympa et évite la boucle et les manipulations d'ajout de virgules entre les valeurs, puis du retrait de la dernière.
Encore merci à vous 2 et merci au forum d'Excel-Pratique.
Bon am
Dan