Trier, suprimer les doublons en additionant les valeurs des cellules voisines

alex santus · 07/02/2010, 10h04

Bnojour à tous,

Voici mon problème,

Dans une feuille je récupere une liste ( je simplifie pour que ce soit plus compréhensible sinon il y a plus de colonne) col A " nom " col B " produits" col C "quantité"

Je voudrai que ma macro boucle sur cette liste qu il compare les colonne A et B sont identique qu il additonne les C et supprime la ligne testé.

pour l instant voici un peut ou j en suis !

Code :

lageFactureOuverte = "a2:a" & WSFactureOuverte.Range("a65536").End(xlUp).Row
                
                For Each CelTestDansFactureOuvert In Range(PlageFactureOuverte)
                For Each CelCibleFactureOuvert In Range(PlageFactureOuverte)
                                
                
                If CelTestDansFactureOuvert = CelCibleFactureOuvert.Offset(1, 0) And CelTestDansFactureOuvert.Offset(0, 2) _
                = CelCibleFactureOuvert.Offset(1, 2) Then
                
                               
                
        
 
                        CelTestDansFactureOuvert.Offset(0, 3) = CelTestDansFactureOuvert.Offset(0, 3) _
                        + CelCibleFactureOuvert.Offset(1, 3)
                        CelTestDansFactureOuvert.Offset(0, 4) = CelTestDansFactureOuvert.Offset(0, 4) _
                        + CelCibleFactureOuvert.Offset(1, 4)
                        CelTestDansFactureOuvert.Offset(0, 6) = CelTestDansFactureOuvert.Offset(0, 6) _
                        + CelCibleFactureOuvert.Offset(1, 6)
                        CelTestDansFactureOuvert.Offset(0, 7) = CelTestDansFactureOuvert.Offset(0, 7) _
                        + CelCibleFactureOuvert.Offset(1, 7)
 
 
                
                    WSFactureOuverte.Range("a" & CelCibleFactureOuvert.Offset(1, 0).Row & ":" & "z" & CelCibleFactureOuvert.Offset(1, 0).Row).ClearContents
                    
                End If
                Next CelCibleFactureOuvert
            
        Next CelTestDansFactureOuvert

Voila si quelqu un saurrai me re-mettre sur la bonne voie, car a force d essayé je commence a faire n importe quoi.

d avance merci

faraudch · 07/02/2010, 11h06

Bonjour,
Peux tu rajouter tes définitions de variables pour que l'on puisse tester.
cordialement.

alex santus · 07/02/2010, 11h26

Bonjour faraudch,

Voici les deux varaible plage en plus

Code :

Sub ListingFactureImpaye()
 
 
 
Dim PlageVente As String
Dim CelTestDansFactureOuvert As Range
Dim PlageFactureOuverte As String
Dim CelCibleFactureOuvert As Range
 
 
 
 
 
                PlageVente = "a2:a" & WSvente.Range("a65536").End(xlUp).Row
 
                
                PlageFactureOuverte = "a2:a" & WSFactureOuverte.Range("a65536").End(xlUp).Row
                
                For Each CelTestDansFactureOuvert In Range(PlageFactureOuverte)
                For Each CelCibleFactureOuvert In Range(PlageFactureOuverte)
               
                
                
                
                If CelTestDansFactureOuvert = CelCibleFactureOuvert.Offset(1, 0) And CelTestDansFactureOuvert.Offset(0, 2) _
                = CelCibleFactureOuvert.Offset(1, 2) Then
                
                
                
                
        
                        CelTestDansFactureOuvert.Offset(0, 3) = CelTestDansFactureOuvert.Offset(0, 3) _
                        + CelCibleFactureOuvert.Offset(1, 3)
                        CelTestDansFactureOuvert.Offset(0, 4) = CelTestDansFactureOuvert.Offset(0, 4) _
                        + CelCibleFactureOuvert.Offset(1, 4)
                        CelTestDansFactureOuvert.Offset(0, 6) = CelTestDansFactureOuvert.Offset(0, 6) _
                        + CelCibleFactureOuvert.Offset(1, 6)
                        CelTestDansFactureOuvert.Offset(0, 7) = CelTestDansFactureOuvert.Offset(0, 7) _
                        + CelCibleFactureOuvert.Offset(1, 7)
 
                End If
               
            Next CelCibleFactureOuvert
        Next CelTestDansFactureOuvert

j espere que tu y verra plus clair

faraudch · 07/02/2010, 11h34

WSvente, WSFactureOuverte, non definis.
Il y en a peut être d'autres.
ch = christian.
A+.

alex santus · 07/02/2010, 12h08

en fait WSvente et WSFactureOuverte sont les nom de mes deux feuilles en vba
, tu peut les remplacer par feuill1 et feuill2.
je ne pense pas que je peux les declarer.
A+

faraudch · 07/02/2010, 12h21

C'est l'heure de manger.
Par contre si ta macro était commantée, je comprendrais mieux.
Bon app.

faraudch · 07/02/2010, 14h52

Essaye ça, ça devrairt marcher.

Code :

Dim CelTestColA As Range
Dim PlageFactureOuverteColA As String
Dim TotalIntermediaire As Integer
Dim DebutLigneSuppression As Integer
Dim LastCell As Integer
 
Sub test()
 
 'on trie sur le nom de la 1) et de la 2° colonne
 Range("a1").Select
      Selection.Sort Key1:=Range("A2"), Order1:=xlAscending, Key2:=Range("B2") _
        , Order2:=xlAscending, Header:=xlGuess, OrderCustom:=1, MatchCase:= _
        False, Orientation:=xlTopToBottom
 
    'on fait les totaux en cas d'égalité de cola et colb
                
                PlageFactureOuverteColA = "a2:a" & Range("a65536").End(xlUp).Row
                LastCell = Range("a65536").End(xlUp).Row
               
                For Each CelTestColA In Range(PlageFactureOuverteColA)
                    If CelTestColA = CelTestColA.Offset(1, 0) Then
                        If CelTestColA.Offset(0, 1) = CelTestColA.Offset(1, 1) Then
                    TotalIntermediaire = CelTestColA.Offset(0, 2).Value + CelTestColA.Offset(1, 2).Value
                    CelTestColA.Offset(1, 2).Value = TotalIntermediaire
                    CelTestColA.Offset(0, 2).Value = 0
                    End If
                    End If
                          
            Next
            
            'on efface les lignes inutiles
        Selection.Sort Key1:=Range("C2"), Order1:=xlDescending, Header:=xlGuess, _
        OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
        
    Columns("C:C").Select
    
    Selection.Find(What:="0", After:=ActiveCell, LookIn:=xlFormulas, LookAt _
        :=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
        False).Activate
        DebutLigneSuppression = ActiveCell.Row
                
    Range("A" & DebutLigneSuppression & ":C" & LastCell).Select
    Selection.Delete Shift:=xlUp
    
            'on retrie sur la première colonne
            
                Selection.Sort Key1:=Range("A2"), Order1:=xlAscending, Key2:=Range("B2") _
        , Order2:=xlAscending, Header:=xlGuess, OrderCustom:=1, MatchCase:= _
        False, Orientation:=xlTopToBottom
  End Sub

mercatog · 07/02/2010, 16h28

Ci-joint une proposition
on ajoute à la fin une colonne où on concatène l'ensemble des colonnes à comparer (ici colonne A: nom et colonne B: produit)
on tri
on fais le cumul
on supprime les lignes en doubles
on efface la colonne ajoutée!
le code ci-joint est testé sur un exemple! à adapter à ton cas

Code :

Sub Cumul()
Dim LastLig As Long, i As Long
With Sheets("WSv")
    LastLig = .Cells(Rows.Count, 1).End(xlUp).Row
    For i = 2 To LastLig
        .Range("D" & i).Value = .Range("A" & i).Value & .Range("B" & i).Value
    Next i
    .Range("A2:D" & LastLig).Sort key1:=.Range("D2"), order1:=xlAscending, header:=xlNo
 
    For i = LastLig To 3 Step -1
        If .Range("D" & i - 1).Value = .Range("D" & i).Value Then
            .Range("C" & i - 1).Value = .Range("C" & i).Value + .Range("C" & i - 1).Value
            .Rows(i).Delete
        End If
    Next i
.Columns("D:D").Clear
End With
End Sub

faraudch · 07/02/2010, 18h09

La même macro avec correction d'un petit bug.

Code :

Dim CelTestColA As Range
Dim PlageFactureOuverteColA As String
Dim TotalIntermediaire As Integer
Dim DebutLigneSuppression As Integer
Dim LastCell As Integer
 
Sub test()
 
 'on trie sur le nom de la 1) et de la 2° colonne
 Range("a1").Select
      Selection.Sort key1:=Range("A2"), order1:=xlAscending, Key2:=Range("B2") _
        , Order2:=xlAscending, header:=xlGuess, OrderCustom:=1, MatchCase:= _
        False, Orientation:=xlTopToBottom
 
    'on fait les totaux en cas d'égalité de cola et colb
                
                PlageFactureOuverteColA = "a2:a" & Range("a65536").End(xlUp).Row
                LastCell = Range("a65536").End(xlUp).Row
               
                For Each CelTestColA In Range(PlageFactureOuverteColA)
                    If CelTestColA = CelTestColA.Offset(1, 0) Then
                        If CelTestColA.Offset(0, 1) = CelTestColA.Offset(1, 1) Then
                    TotalIntermediaire = CelTestColA.Offset(0, 2).Value + CelTestColA.Offset(1, 2).Value
                    CelTestColA.Offset(1, 2).Value = TotalIntermediaire
                    CelTestColA.Offset(0, 2).Value = 0
                    End If
                    End If
                          
            Next
            
            'on efface les lignes inutiles
        Selection.Sort key1:=Range("C2"), order1:=xlDescending, header:=xlGuess, _
        OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
        
       'on cherche la première cellule = à 0
    For i = 2 To LastCell
        If Range("c" & i).Value = 0 Then
                Range("c" & i).Select
                DebutLigneSuppression = ActiveCell.Row
                Exit For
                End If
 
    Next
               
    Range("A" & DebutLigneSuppression & ":C" & LastCell).Select
    Selection.Delete Shift:=xlUp
    
            'on retrie sur la première colonne
            
                Selection.Sort key1:=Range("A2"), order1:=xlAscending, Key2:=Range("B2") _
        , Order2:=xlAscending, header:=xlGuess, OrderCustom:=1, MatchCase:= _
        False, Orientation:=xlTopToBottom
End Sub

p0l1n · 07/02/2010, 20h36

jai eu une application qui ressemblait a ce que tu veux faire, et une solution simple qui enleve les doublons et additions tout tes résultats est un tableau dynamique

pour ton tableau dans la colonne, mais tes données de la colA et les données de la ColB, et dans la case value met les valeurs de ta ColC.

si tu utilise un bouton ou autre pour le traitement de tes données jai commencé ma macro en mettant à jour le tableau dynamique comme suis :

Code :

Set pvtTable = ActiveSheet.Range("Case de ton tableau").PivotTable
pvtTable.RefreshTable

ensuite traite ton tableau comme bon te semble, et tes données se mettent à jour et sont classés sans doublons.

Bonne journée !

alex santus · 07/02/2010, 20h51

Bonsoir à vous deux,

désolé de n avoir pas été plus réactif mes j était absent de chez moi.
je viens de rentrer et je me suis empresser a mettre en œuvre les solution proposé.

Mercatog, j ai essayé le tienne en premier car elle me paraissait plus facile a mettre en ordre par rapport au vrai cellule que je trie.

et la comme par magie tout c est mis la ou je le voulais, mon problème c est que je n avais bien compris que pour faire un tri comme cela il fallait commencer par la dernière ligne additionner et supprimer au fur et a mesure. enfin après deux jour que je m arrache les cheveux ca marche. mille merci pour ton aide.

Faraudch

comme tu peut le lire ci dessus j ai commencer par le code de mercatog car c était plus simple pour moi de l adapter rapidement,
ceci dit demain je ferrai quelque essai avec le tiens.
pour pouvoir comprendre une autre approche pour réalisé ce tri.

merci a toi aussi de t être penchée sur mon problème.

à bientôt et bonne soirée

Alex

07/02/2010, 11h06	#2 (permalink)
faraudch Membre du Club Date d'inscription: septembre 2008 Localisation: Limoges (87) Âge: 57 Messages: 83	Bonjour, Peux tu rajouter tes définitions de variables pour que l'on puisse tester. cordialement.

07/02/2010, 11h34	#4 (permalink)
faraudch Membre du Club Date d'inscription: septembre 2008 Localisation: Limoges (87) Âge: 57 Messages: 83	WSvente, WSFactureOuverte, non definis. Il y en a peut être d'autres. ch = christian. A+.

07/02/2010, 12h08	#5 (permalink)
alex santus Membre à l'essai Date d'inscription: mai 2009 Localisation: Mons, Belgique Messages: 44	en fait WSvente et WSFactureOuverte sont les nom de mes deux feuilles en vba , tu peut les remplacer par feuill1 et feuill2. je ne pense pas que je peux les declarer. A+

07/02/2010, 12h21	#6 (permalink)
faraudch Membre du Club Date d'inscription: septembre 2008 Localisation: Limoges (87) Âge: 57 Messages: 83	C'est l'heure de manger. Par contre si ta macro était commantée, je comprendrais mieux. Bon app.

07/02/2010, 20h36	#10 (permalink)
p0l1n Candidat au titre de Membre du Club Date d'inscription: janvier 2010 Messages: 24	jai eu une application qui ressemblait a ce que tu veux faire, et une solution simple qui enleve les doublons et additions tout tes résultats est un tableau dynamique pour ton tableau dans la colonne, mais tes données de la colA et les données de la ColB, et dans la case value met les valeurs de ta ColC. si tu utilise un bouton ou autre pour le traitement de tes données jai commencé ma macro en mettant à jour le tableau dynamique comme suis : Code : Set pvtTable = ActiveSheet.Range("Case de ton tableau").PivotTable pvtTable.RefreshTable ensuite traite ton tableau comme bon te semble, et tes données se mettent à jour et sont classés sans doublons. Bonne journée !

07/02/2010, 20h51	#11 (permalink)
alex santus Membre à l'essai Date d'inscription: mai 2009 Localisation: Mons, Belgique Messages: 44	Bonsoir à vous deux, désolé de n avoir pas été plus réactif mes j était absent de chez moi. je viens de rentrer et je me suis empresser a mettre en œuvre les solution proposé. Mercatog, j ai essayé le tienne en premier car elle me paraissait plus facile a mettre en ordre par rapport au vrai cellule que je trie. et la comme par magie tout c est mis la ou je le voulais, mon problème c est que je n avais bien compris que pour faire un tri comme cela il fallait commencer par la dernière ligne additionner et supprimer au fur et a mesure. enfin après deux jour que je m arrache les cheveux ca marche. mille merci pour ton aide. Faraudch comme tu peut le lire ci dessus j ai commencer par le code de mercatog car c était plus simple pour moi de l adapter rapidement, ceci dit demain je ferrai quelque essai avec le tiens. pour pouvoir comprendre une autre approche pour réalisé ce tri. merci a toi aussi de t être penchée sur mon problème. à bientôt et bonne soirée Alex

		Forum des professionnels en informatique > Logiciels > Microsoft Office > Excel > Macros et VBA Excel
Trier, suprimer les doublons en additionant les valeurs des cellules voisines

Outils de la discussion
Afficher une version imprimable Envoyer un lien vers cette page par email