Trier et compter avec une macro

THIERRY35

XLDnaute Occasionnel
Bonjour
j'ai une dizaine de fichiers à retraiter faisant chacun, entre 500 et 800 lignes.
Le but est de simplifier la lecture de la façon suivante:
n'avoir qu'une seule ligne pour chaque numéro de facture commençant par V (dans la colonne A)
tout d'abord additionner les valeurs qui se trouvent en colonne J et qui sont rattachés au numéro de facture, puis supprimer toutes les lignes si aucune valeur en colonne A et ainsi de suite,
J'ai donc besoin d'une macro,
et merci d'avance aux courageux qui ne sont pas en vacances de m'aiderà écrire cette macro !!
Thierry

PJ un extrait du fichier pour y voir plus clair.
 

Pièces jointes

  • MODELES RETRAITEMENT.xls
    26 KB · Affichages: 35

pedrag31

XLDnaute Occasionnel
Re : Trier et compter avec une macro

Bonjour le fil,

Un autre essai... :p


VB:
Private Sub CommandButton1_Click()

'supprime la feuille RESUME FACTURES" si elle existe déjà
On Error Resume Next
Application.DisplayAlerts = False
Worksheets("RESUME FACTURES").Delete
Application.DisplayAlerts = True
On Error GoTo 0

DoEvents

'insère une nouvelle feuille nommée "RESUME FACTURES"
Worksheets.Add , Worksheets("DONNEES BRUTES")
ActiveSheet.Name = "RESUME FACTURES"

'copie la ligne de titres dans la nouvelle feuille
Worksheets("DONNEES BRUTES").Rows(1).Copy Destination:=Worksheets("RESUME FACTURES").Range("A1")

lignecopie = 2

For Each cell In Worksheets("DONNEES BRUTES").Range("A2:A" & Worksheets("DONNEES BRUTES").UsedRange.Rows.Count)

    'si la colonne A contient un numéro de facture type "*V*" alors on copie la ligne
    If cell.Text Like "*V*" Then
        Worksheets("DONNEES BRUTES").Rows(cell.Row).Copy Destination:=Worksheets("RESUME FACTURES").Range("A" & lignecopie)
        lignecopie = lignecopie + 1
    'sinon si la valeur en cellule I est non nulle alors on additionne avec la ligne précédente
    ElseIf Not cell.Text Like "*V*" And Worksheets("DONNEES BRUTES").Range("J" & cell.Row).Value <> "" Then
        If Worksheets("RESUME FACTURES").Range("J" & lignecopie - 1).Value = "" Then 'si cellule J vide
            Worksheets("RESUME FACTURES").Range("J" & lignecopie - 1).Value = Worksheets("DONNEES BRUTES").Range("J" & cell.Row).Value
        ElseIf Worksheets("RESUME FACTURES").Range("J" & lignecopie - 1).Value <> "" Then ' si cellule J déjà remplie
            Worksheets("RESUME FACTURES").Range("J" & lignecopie - 1).Value = Worksheets("RESUME FACTURES").Range("J" & lignecopie - 1).Value + Worksheets("DONNEES BRUTES").Range("J" & cell.Row).Value
        End If
    End If
    
Next cell
    
End Sub

Bonne journée :)
 

Pièces jointes

  • RetraitementDeFactures.xls
    61 KB · Affichages: 48
Dernière édition:

Discussions similaires

Statistiques des forums

Discussions
312 629
Messages
2 090 321
Membres
104 491
dernier inscrit
anthony2812