Ajouter des quantités et supprimer les lignes

**Yullll** · 06/01/2016, 12h29

Bonjour,

Dans le cadre d'un projet d'étude, il me faut réaliser une macro dans laquelle je dois faire des extractions de certains fichier ( déja réalisé). Dans un deuxième temps mon classeur contient donc une colonne avec les référence : la A et une colonne avec les quantité : la C. Il se trouve que certaine ligne j'ai la même référence avec des quantités différentes. Cela est du a un code fournisseur différent. Il me faut donc a chaque fois qu'il repère la même référence ajouter les quantité et supprimer les lignes inutiles .... J'ai déja réaliser des macro simple de suppression des doublons cependant comme cela jamais ... Quelqu'un pourrait il m'aider ?

**Daniel.C** · 06/01/2016, 12h52

Bonjour,

Est-ce que tu peux donner un exemple concret ? Parce que, comme ça c'est un peu abstrait.

**Yullll** · 06/01/2016, 13h40

test.xls

Voici un exemple de fichier on a une référence commune pour les trois éléments. Et je voudrais me retrouvé avec une seule ligne avec la référence et les quantité ajoutées soit Ref : 3547865345 Qté : 11. J'espère que j'ai été assez clair, et j'ai le cas pour plusieurs références.

**Daniel.C** · 06/01/2016, 14h46

Les données de départ sont en colonne A et B de Feuil3. Les résultats sont en Feuil4 :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
Sub test()
    Dim C As Range, Plage As Range, Dico As Object, Ligne As Long, Lig As Long
    Set Dico = CreateObject("Scripting.Dictionary")
    With Sheets("Feuil3")
        Set Plage = .Range("A1", .Cells(.Rows.Count, 1).End(xlUp))
    End With
    With Sheets("Feuil4")
        For Each C In Plage
            If Not Dico.exists(C.Value) Then
                Dico.Add C.Value, C.Value
                Ligne = Ligne + 1
                .Cells(Ligne, 1) = C.Value
                .Cells(Ligne, 2) = C.Offset(, 1).Value
            Else
                Lig = Application.Match(C.Value, .[A:A], 0)
                .Cells(Lig, 2).Value = .Cells(Lig, 2).Value + C.Offset(, 1).Value
            End If
        Next C
    End With
End Sub

**Yullll** · 06/01/2016, 15h32

Merci Daniel.C j'essaye d'adapter ta macro a mon problème mais j'aimerais en fait me refaire un tableau sur la meme feuille mais a côté. Il faudrait que je change quoi ??

**Daniel.C** · 06/01/2016, 15h54

C'est toi qui a demandé une macro. Regarde le classeur :

https://www.dropbox.com/s/c26lgw2kwf...llll.xlsm?dl=0

Tu as aussi une solution par formules sur Feuil3 en colonnes G et H.

**Yullll** · 06/01/2016, 16h24

Oui oui c'est parfait j'ai réussi a me la mettre a ma sauce, donc mon problème maintenant c'est que en fait il y'a des référence qui n'ont pas de doublons.
Avec cette macro je traite la recopie en Feuil 3 que des doublons. Il faudrait que je puisse recopier le reste des références en le laissant tel quel. Comment puis je faire ??

**Daniel.C** · 06/01/2016, 16h33

Le mieux serait que tu mettes ton classeur en pièce jointe.

**Yullll** · 06/01/2016, 16h43

Classeur stock.xls

Voici le type de tableau que j'ai. Il y'a certaine référence ou il y a plusieurs quantités, c'est celle la que je voudrais additionner. Cela me permettrait de connaitre le stock par référence. De plus il faudrait également que les autres références se recopient afin que je puisse faire une analyse fine du stock.

Merci de ton aide

**Daniel.C** · 06/01/2016, 17h19

Teste :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
Sub test()
    Dim C As Range, Plage As Range, Dico As Object, Ligne As Long, Lig As Long
    Set Dico = CreateObject("Scripting.Dictionary")
    With Sheets("Stock")
        Set Plage = .Range("A1", .Cells(.Rows.Count, 1).End(xlUp))
    End With
    With Sheets("Feuil2")
        For Each C In Plage
            If Not Dico.exists(C.Value) Then
                Dico.Add C.Value, C.Value
                Ligne = Ligne + 1
                If IsNumeric(C.Value) Then
                    .Cells(Ligne, 1).NumberFormat = "@"
                End If
                .Cells(Ligne, 1) = C.Value
                .Cells(Ligne, 2) = C.Offset(, 1).Value
            Else
                Lig = Application.Match(C.Value, .[A:A], 0)
                .Cells(Lig, 2).Value = .Cells(Lig, 2).Value + C.Offset(, 1).Value
            End If
        Next C
    End With
End Sub

**Yullll** · 06/01/2016, 17h31

Beh écoute c'est parfait chapeau !!!!

Merci beaucoup, j'aurais surement d'autres questions existentielles sur VBA ^^

**Daniel.C** · 06/01/2016, 17h42

Pas de problème.

Bonne soirée.

**Yullll** · 06/01/2016, 18h03

Sur mon premier tableau la macro a super bien tourné, cependant je voulais faire deux autres sub pour deux autres onglets et j ai une erreur juste après le else ! Es ce que tu sais de où ça peut venir ??

**Daniel.C** · 06/01/2016, 18h07

Quel est le message d'erreur ?

**Yullll** · 07/01/2016, 08h52

Bonjour, donc en fait quand je le lance pour onglet ca passe mais quand je veux l'appliquer aux deux autres impossible.
Le message d'erreur est le suivant : Erreur d'éxecution '13' :Incompatibilité de type.
Et dans le débogage il me surligne cette ligne : Lig = Application.Match(C.Value, .[A:A], 0)Voici le code que j'ai rentré, il y'a 3 sub associé a 3 boutons :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
Sub stock()
 
    Dim C As Range, Plage As Range, Dico As Object, Ligne As Long, Lig As Long
    Set Dico = CreateObject("Scripting.Dictionary")
    With Sheets("stock S")
        Set Plage = .Range("A1", .Cells(.Rows.Count, 1).End(xlUp))
    End With
    With Sheets("stocks S1")
        For Each C In Plage
            If Not Dico.exists(C.Value) Then
                Dico.Add C.Value, C.Value
                Ligne = Ligne + 1
                If IsNumeric(C.Value) Then
                    .Cells(Ligne, 1).NumberFormat = "@"
                End If
                .Cells(Ligne, 1) = C.Value
                .Cells(Ligne, 2) = C.Offset(, 1).Value
            Else
                Lig = Application.Match(C.Value, .[A:A], 0)
                .Cells(Lig, 2).Value = .Cells(Lig, 2).Value + C.Offset(, 1).Value
            End If
        Next C
    End With
End Sub
Sub Entrées()
Dim C As Range, Plage As Range, Dico As Object, Ligne As Long, Lig As Long
    Set Dico = CreateObject("Scripting.Dictionary")
    With Sheets("Entrées S")
        Set Plage = .Range("A1", .Cells(.Rows.Count, 1).End(xlUp))
    End With
    With Sheets("Entrées S1")
        For Each C In Plage
            If Not Dico.exists(C.Value) Then
                Dico.Add C.Value, C.Value
                Ligne = Ligne + 1
                If IsNumeric(C.Value) Then
                    .Cells(Ligne, 1).NumberFormat = "@"
                End If
                .Cells(Ligne, 1) = C.Value
                .Cells(Ligne, 2) = C.Offset(, 1).Value
            Else
                Lig = Application.Match(C.Value, .[A:A], 0)
                .Cells(Lig, 2).Value = .Cells(Lig, 2).Value + C.Offset(, 1).Value
            End If
        Next C
    End With
    End Sub
    Sub Sorties()
 
 
    Dim C As Range, Plage As Range, Dico As Object, Ligne As Long, Lig As Long
    Set Dico = CreateObject("Scripting.Dictionary")
    With Sheets("Sorties S")
        Set Plage = .Range("A1", .Cells(.Rows.Count, 1).End(xlUp))
    End With
    With Sheets("Sorties S1")
        For Each C In Plage
            If Not Dico.exists(C.Value) Then
                Dico.Add C.Value, C.Value
                Ligne = Ligne + 1
                If IsNumeric(C.Value) Then
                    .Cells(Ligne, 1).NumberFormat = "@"
                End If
                .Cells(Ligne, 1) = C.Value
                .Cells(Ligne, 2) = C.Offset(, 1).Value
            Else
                Lig = Application.Match(C.Value, .[A:A], 0)
                .Cells(Lig, 2).Value = .Cells(Lig, 2).Value + C.Offset(, 1).Value
            End If
        Next C
    End With
 
    End Sub

As tu une idée de comment je pourrais m'en sortir ?

**Daniel.C** · 07/01/2016, 09h35

Bonjoour,

Ca vient de tes données. Est-ce que tu peux mettre un lien sur le classeur ? Je m'absente et serai de retoour en fin d'après-midi.

**Yullll** · 07/01/2016, 11h19

Voici le classeur avec les trois Feuil a savoir : stock, entrées et sorties.
Tu verras dans le classeur j'ai réussi a lancé la macro sur le stock et les entrées mais aux niveaux des sorties ca marche pas !
Merci de ton aide !Classeur1-données stock.xls

**Daniel.C** · 07/01/2016, 17h46

Macro Stock, il faut remplacer :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
 
With Sheets("Feuil1")

par :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

With Sheets("STOCK")

Il faut changer également le nom de la feuille pour les macros Entréees et Sorties. Pour cette dernière, dont les données d'entrée commencent en ligne 3, il faut modifier ainsi :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
    Sub Sorties()
 
 
    Dim C As Range, plage As Range, Dico As Object, Ligne As Long, Lig As Long
    Set Dico = CreateObject("Scripting.Dictionary")
    With Sheets("Sorties")
        Set plage = .Range("A3", .Cells(.Rows.Count, 1).End(xlUp))
    End With
    With Sheets("Feuil6")
        For Each C In plage
            If Not Dico.exists(C.Value) Then
                Dico.Add C.Value, C.Value
                Ligne = Ligne + 1
                If IsNumeric(C.Value) Then
                    .Cells(Ligne, 1).NumberFormat = "@"
                End If
                .Cells(Ligne, 1) = C.Value
                .Cells(Ligne, 2) = C.Offset(, 1).Value
            Else
                Lig = Application.Match(C.Value, .[A:A], 0)
                .Cells(Lig, 2).Value = .Cells(Lig, 2).Value + C.Offset(, 1).Value
            End If
        Next C
    End With
 
    End Sub

**courly** · 03/08/2021, 08h35

Bonjour,
j'ai un fichier avec une macro pour insérer des lignes de produits avec prix et quantités.
Je voudrais avoir un bouton qui ajoute une quantité à la ligne. Est-ce possible ?
Merci pour votre aide.