XL 2019 Filtre Avancé avec un tableau comme cristaire vba

  • Initiateur de la discussion Initiateur de la discussion iliess
  • Date de début Date de début

Boostez vos compétences Excel avec notre communauté !

Rejoignez Excel Downloads, le rendez-vous des passionnés où l'entraide fait la force. Apprenez, échangez, progressez – et tout ça gratuitement ! 👉 Inscrivez-vous maintenant !

iliess

XLDnaute Occasionnel
Bonjour
est ce que je peux utiliser un tableau Arr comme la plage d'un filtre avancé et le tableau Grr comme plage de critère.
voici le code suivant

VB:
Sub test()
Dim ShBa As Worksheet, ShGr As Worksheet
Dim LignA As Long
Dim Arr
Set ShBa = ThisWorkbook.Worksheets("BaseD")
Set ShGr = ThisWorkbook.Worksheets("Resultat")
LignA = ShBa.Cells(ShBa.Rows.Count, 1).End(xlUp).Row
lignb = ShGr.Cells(ShGr.Rows.Count, 1).End(xlUp).Row
Arr = ShBa.Range("A2:I" & LignA)
n = 2
'================================================================
For i = LBound(Arr, 1) To UBound(Arr, 1)
    If Arr(i, 9) <> "Non" Then
            ShBa.Range("M" & n) = ("'" & Arr(i, 4))
            ShBa.Range("N" & n) = "*445"
            n = n + 1
    End If
Next i
'================================================================
ShBa.Range("A1:I" & LignA).AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=Range("M1").CurrentRegion, CopyToRange:=Sheets("Resultat").Range("A1"), Unique:=False
End Sub
le tableau Arr = Range("A1").CurrentRegion
le tableau Grr = Range("M1").CurrentRegion

est ce que je peux remplir le tableau Grr on utilisent cette boucle

Code:
For i = LBound(Arr, 1) To UBound(Arr, 1)

    If Arr(i, 9) <> "Non" Then

            Grr(i,1) = ("'" & Arr(i, 4))

            Grr(i,2) = "*445"

            n = n + 1

    End If

Next i
Arr.AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=Grr, CopyToRange:=Sheets("Resultat").Range("A1"), Unique:=False
 

Pièces jointes

- Navigue sans publicité
- Accède à Cléa, notre assistante IA experte Excel... et pas que...
- Profite de fonctionnalités exclusives
Ton soutien permet à Excel Downloads de rester 100% gratuit et de continuer à rassembler les passionnés d'Excel.
Je deviens Supporter XLD

Discussions similaires

Réponses
12
Affichages
505
Réponses
3
Affichages
537
Retour