trier des lignes avec VBA

[francky80]

Bonsoir a tous je me creuse la tête a fond. serrait il possible de tirer des lignes par date et par catégorie, avec sous total par date et catégorie sur une autre feuille et sans ligne vide comme le montre le fichier ci-joint. Je ne m'en sors pas avec ce genre de tableau et qu'une solution VBA serait la bienvenue. Merci a vous tous bye et bonne soirée. 🙂



[file name=Tri_20050928232007.zip size=15678]http://www.excel-downloads.com/components/com_simpleboard/uploaded/files/Tri_20050928232007.zip[/file]

 

[myDearFriend!]

Bonsoir francky80,

Dans ton exemple ci-joint modifié, une façon de faire...

J'ai utilisé cette procédure :

Private Sub ButtonOk_Click()
Dim TabTemp As Variant
Dim Plage As Range
Dim Achat As String
Dim C As Integer
Dim L As Long, LR As Long
Dim Tot As Currency
Dim Gras As Boolean

      With Sheets('Feuil1')
            'Mémorise les données brutes
            L = .Range('B65536').End(xlUp).Row
            TabTemp = .Range(.Cells(6, 2), .Cells(L, 5)).Value
      End With
      With Sheets('Feuil2')
            'RAZ résultat
            .Range('B6:E65536').ClearContents
            'Collage des données et Tri
            Set Plage = .Range(.Cells(6, 2), .Cells(L, 5))
            Plage.Value = TabTemp
            Plage.Sort Key1:=.Range('B6'), Order1:=xlAscending, Key2:=.Range('D6') _
                  , Order2:=xlAscending, Key3:=.Range('C6'), Order3:=xlAscending, Header:= _
                  xlNo, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
            'Mémorise données triées
            TabTemp = Plage.Value
            'RAZ données
            .Range('B6:E65536').ClearContents
            LR = 6
            For L = 1 To UBound(TabTemp, 1)
                  'Si date OK
                  If TabTemp(L, 1) = ComboBox1.Value Then
                        'Sous-total
                        If TabTemp(L, 3) <> Achat And Tot <> 0 Then
                              .Cells(LR, 2).Value = 'Sous-total'
                              .Cells(LR, 5).Value = Tot
                              Tot = 0
                              LR = LR + 1
                              Gras = True
                        Else
                              Gras = False
                        End If
                        .Range(.Cells(LR - 1, 2), .Cells(LR - 1, 5)).Font.Bold = Gras
                        'Affiche la ligne
                        Achat = TabTemp(L, 3)
                        For C = 1 To 4
                              .Cells(LR, C + 1).Value = TabTemp(L, C)
                        Next C
                        Tot = Tot + TabTemp(L, 4)
                        LR = LR + 1
                  End If
            Next L
            .Cells(LR, 2).Value = 'Sous-total'
            .Cells(LR, 5).Value = Tot
            .Range(.Cells(LR, 2), .Cells(LR, 5)).Font.Bold = True
      End With
      Sheets('Feuil2').Activate
      Unload Me
End Sub

Cordialement, [file name=PourFrancky80.zip size=16981]http://www.excel-downloads.com/components/com_simpleboard/uploaded/files/PourFrancky80.zip[/file]

 

[francky80]

salut myDearFriend! je te remerci tu m'enlève une epine du pied c'est vraimant gentil 'super ce forum' et encore merci pour tout c'est super cool :woohoo: