trier des lignes avec VBA

francky80

XLDnaute Nouveau
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]
 

Pièces jointes

  • Tri_20050928232007.zip
    15.3 KB · Affichages: 39

myDearFriend!

XLDnaute Barbatruc
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]
 

Pièces jointes

  • PourFrancky80.zip
    16.6 KB · Affichages: 51

Discussions similaires

Membres actuellement en ligne

Aucun membre en ligne actuellement.

Statistiques des forums

Discussions
300 761
Messages
1 987 020
Membres
209 681
dernier inscrit
Excelcrable