Filtre sur valeur

Bonjour

il y a très longtemps que je n'ai pas pratiquer VBA.

J'ai ce code :

    ' Filtre du plus petit au plus grand n° de collecte
    Selection.AutoFilter
    ActiveWorkbook.Worksheets("ExportParkfolioTransactions_Oul").AutoFilter.Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("ExportParkfolioTransactions_Oul").AutoFilter.Sort. _
    SortFields.Add2 Key:=Range("A1:A32260"), SortOn:=xlSortOnValues, Order:= _
    xlAscending, DataOption:=xlSortNormal
    With ActiveWorkbook.Worksheets("ExportParkfolioTransactions_Oul").AutoFilter.Sort
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    Selection.AutoFilter

    Selection.AutoFilter ' Ouvre le filtre
    Dim st1#, st2#, st3#, st4#, st5#, st6#, st7#, st8#, st9#, st10#, st11#, st12#, st13#, st14#, st15#, st16#, st17#, st18#, st19#, st20#
    Dim st21#, st22#, st23#, st24#, st25#, st26#, st27#, st28#, st29#, st30#, st31#, st32#, st33#, st34#, st35#, st36#, st37#, st38#, st39#, st40#
    Dim st41#, st42#, st43#, st44#, st45#, st46#, st47#, st48#, st49#, st50#, st51#, st52#, st53#, st54#, st55#, st56#, st57#, st58#, st59#, st60#
    Dim st61#, st62#, st63#, st64#, st65#, st66#, st67#, st68#, st69#, st70#, st71#, st72#, st73#
    'numCollecte = Range("A2").Value
        ActiveSheet.Range("$A$1").AutoFilter Field:=1, Criteria1:="2534"
        Columns("B:B").Select
        st1# = Application.Subtotal(9, Selection)
        MsgBox st1#
        ActiveSheet.Range("$A$1").AutoFilter Field:=1, Criteria1:="2535"
        Columns("B:B").Select
        st2# = Application.Subtotal(9, Selection)
        MsgBox st2#
        ActiveSheet.Range("$A$1").AutoFilter Field:=1, Criteria1:="2536"
        Columns("B:B").Select
        st3# = Application.Subtotal(9, Selection)
        MsgBox st3#
        ActiveSheet.Range("$A$1").AutoFilter Field:=1, Criteria1:="2537"
        Columns("B:B").Select
        st4# = Application.Subtotal(9, Selection)
        MsgBox st4#
        ActiveSheet.Range("$A$1").AutoFilter Field:=1, Criteria1:="2538"
        Columns("B:B").Select
        st5# = Application.Subtotal(9, Selection)
        MsgBox st5#
        ActiveSheet.Range("$A$1").AutoFilter Field:=1, Criteria1:="2539"
        Columns("B:B").Select
        st6# = Application.Subtotal(9, Selection)
        MsgBox st6#
        ActiveSheet.Range("$A$1").AutoFilter Field:=1, Criteria1:="2540"
        Columns("B:B").Select
        st7# = Application.Subtotal(9, Selection)
        MsgBox st7#
        ActiveSheet.Range("$A$1").AutoFilter Field:=1, Criteria1:="2541"
        Columns("B:B").Select
        st8# = Application.Subtotal(9, Selection)
        MsgBox st8#

    Selection.AutoFilter ' Ferme le filtre

cela concerne la partie du bas ou j'ai créer toutes ces variables : st1# st2# etc...qui me permettent de récupérer les valeurs lorsque je procèdes à un filtre sur chaque valeur de ma 1ère colonne ex : "2534" je récupère mon sous total, "2535" je récupère mon sous total , etc. etc...

Comment je pourrais faire pour ne pas taper 73 fois au total toutes ces lignes ?

ActiveSheet.Range("$A$1").AutoFilter Field:=1, Criteria1:="2541"
        Columns("B:B").Select
        st8# = Application.Subtotal(9, Selection)
        MsgBox st8#

sachant que je dois aller de 2534 à 2607.

Merci

Bonjour

Tu devrais joindre ton fichier, au besoin anonymisé....

Bye !

Bonjour,

J'ai bossé dur et j'ai trouvé cela :

Dim sousTotal#
    Dim numCollecte%
    Dim maCellule As Range

    numCollecte = Range("D2").Value
        For i = numCollecte To 2743
                ActiveSheet.Range("$D$1").AutoFilter Field:=4, Criteria1:=i

                Columns("E:E").Select
                sousTotal = Application.Subtotal(9, Selection)

                Select Case numCollecte
                    Case Is = 2534
                    Set maCellule = ThisWorkbook.Sheets("Feuil1").Range("D29")
                    maCellule.Value = sousTotal
                    Case Is = 2535
                    Set maCellule = ThisWorkbook.Sheets("Feuil1").Range("D30")
                    maCellule.Value = sousTotal
                    Case Is = 2536
                    Set maCellule = ThisWorkbook.Sheets("Feuil1").Range("D31")
                    maCellule.Value = sousTotal
                End Select
                'MsgBox sousTotal
            If (sousTotal < 1) Then
            Exit For
            End If
        Next i

la boucle fonctionne bien, sauf que maintenant c'est avec "Select Case Is" que je bloque.

Je veux que lorsque ma boucle trouve par exemple la valeur : 2534, que cela me copie la valeur de la variable "sousTotal" dans la cellule "D29". et ainsi de suite....

Alors, quand je lance le prog ca va jusqu'au bout, mais rien n'est copié dans cette cellule "D29" ??

bon j'ai trouvé ca :

Dim sousTotal#
    Dim numCollecte%

    numCollecte = Range("D2").Value
        For i = numCollecte To 2743
                'MsgBox i
                ActiveSheet.Range("$D$1").AutoFilter Field:=4, Criteria1:=i

                Columns("E:E").Select
                souTsotal = Application.Subtotal(9, Selection)

                    Sheets("Feuil1").Range("A1").Value = i
                    Sheets("Feuil1").Range("B1").Value = souTsotal

               MsgBox sousTotal

                If (sousTotal < 1) Then
                Exit For
                End If
        Next i

Mes variables i et sousTotal sont bien copié dans A1 et B1 respectivement.

Mais je voudrais que cela continue en copiant les nouvelles variables i et sousTotal dans A2 et B2, A3 et B3, etc etc...

Il faut que je fasse une boucle for mais comment ?

bonjour quattro1

comme ceci ?

Sub test()
     Dim sousTotal#
     Dim numCollecte%

     Sheets("Feuil1").Range("A1").Resize(, 2).EntireColumn.ClearContents     'vider ces 2 colonnes
     With ActiveSheet
          numCollecte = .Range("D2").Value
          For i = numCollecte To 2743
               'MsgBox i
               .Range("$D$1").AutoFilter Field:=4, Criteria1:=i
               souTsotal = Application.Subtotal(9, .Columns("E"))
               Sheets("Feuil1").Range("A" & i - numCollecte + 1).Resize(, 2).Value = Array(i, souTsotal)
               If (sousTotal < 1) Then Exit For
          Next i
     End With
End Sub

merci, très bien.

maintenant je m'aperçois que j'ai plusieurs plage de la variable "numCollecte" à vérifier et non pas :

For i = numCollecte To 2743

mes plages s'organisent comme ca :

"numCollecte" allant de : 2534 à 2572.

"numCollecte" allant de : 2707 à 2720.

"numCollecte" allant de : 2722 à 2726.

"numCollecte" allant de : 2728 à 2739.

"numCollecte" allant de : 2741 à 2743.

Car sinon je suis obligé de passer par des valeurs de "numCollecte" qui ne m'intéresse pas du tout, et alourdie du coup ma boucle FOR.

Faut il faire le code avec un FOR comme auparavant ? ou bien passé par autre chose ?

j'ai trouvé cela :

Dim sousTotal#
     Dim numCollecte%
     Sheets("Feuil1").Range("A1").Resize(, 2).EntireColumn.ClearContents 'vider ces 2 colonnes
     With ActiveSheet
          numCollecte = .Range("D2").Value
          For i = numCollecte To 2743
            If (i >= 2534 And i <= 2572) Or (i >= 2707 And i <= 2720) _
            Or (i >= 2722 And i <= 2726) Or (i >= 2728 And i <= 2739) _
            Or (i >= 2741 And i <= 2743) Then
              'MsgBox i
              .Range("$D$1").AutoFilter Field:=4, Criteria1:=i
              sousTotal = Application.Subtotal(9, .Columns("E"))
              Sheets("Feuil1").Range("A" & i - numCollecte + 1).Resize(, 2).Value = Array(i, sousTotal)
              If (sousTotal < 0) Then Exit For
            End If
          Next i
     End With

en insérant la condition IF cela fonctionne, sauf que, je me retrouve avec des lignes vide entre chaque paliers, donc du vide....

comment les supprimer ?

re,

     Dim sousTotal#
     Dim numCollecte%

     Sheets("Feuil1").Range("A1").Resize(, 2).EntireColumn.ClearContents     'vider ces 2 colonnes
     With ActiveSheet
          numCollecte = .Range("D2").Value
          For i = numCollecte To 2743
               Select Case i
                    Case 2534 To 2572, 2707 To 2720, 2722 To 2726, 2728 To 2739, 2741 To 2743
                         .Range("$D$1").AutoFilter Field:=4, Criteria1:=i
                         sousTotal = Application.Subtotal(9, .Columns("E"))
                         Sheets("Feuil1").Range("A" & Rows.Count).End(xlUp).Offset(1).Resize(, 2).Value = Array(i, sousTotal)
                         If (sousTotal < 0) Then Exit For
               End Select
          Next i
     End With