Discussion :

[froutloops62]

Bonjour,

Je cherche via VBA à grouper les lignes dont une cellule est identique, en calculer le nombre et faire la somme des quantités. (Comme le ferait un tableau TCD).

Pourriez-vous m'aider s'il vous plaît.

[RyuAutodidacte]

Bonjour,

Avec quelques petites recherches sur le net on peut trouver des solutions
ou même le faire soit même avec le B.A.BA d'excel et de simples formules …

Sinon voici une solution à adapter : https://www.developpez.net/forums/d1...s/#post8675891

PS : comme la plupart je n'ouvre pas les fichiers joints, et encore moins dés le 1er post, cf. Règles du forum

[froutloops62]

Merci RyuAutodidacte,

Je vais étudier le post que tu as mis en lien.

Je sais bien qu'avec le B.A.BA d'Excel je peux m'en sortir ou avec un simple tableau croisé dynamique.

Mais je veux automatiser le traitement via VBA et là, en tant que débutant en programmation : je galère !

J'ai cherché sur le net sans vraiment trouver la solution ou su l'adapter à mon besoin.

Et adapter sans comprendre ce n'est pas ce que je recherche : j'ai envie d'apprendre.

Désolé pour la pièce jointe : je ne savais pas.

[RyuAutodidacte]

re,

pour commencer je te conseille de lire :
- http://silkyroad.developpez.com/VBA/LesVariables/
- http://didier-gonard.developpez.com/...s-tableau-vba/ + http://silkyroad.developpez.com/vba/tableaux/
- https://msdn.microsoft.com/fr-fr/lib...(v=vs.90).aspx + http://silkyroad.developpez.com/excel/doublons/#LIV-A + http://silkyroad.developpez.com/excel/doublons/#LIV-B + http://silkyroad.developpez.com/excel/doublons/#LIV-F

et pour effectuer le code le faire en Pas à pas avec la touche F8 en ayant d'ouvert la fenêtre des variables locales afin de voir ce qui s'y passe à chaque pas dans le code

après si tu as quelques soucis, en ayant fait quand même au préalable un minimum de travail afin d'essayer de comprendre, reviens avec tes questions sur les points bloquants

[froutloops62]

Bonjour RyuAutodidacte,

J'ai pu bosser sur tes éléments (merci beaucoup) et ça fonctionne plutôt pas mal.

En revanche, j'ai 2 questions :


1 - Le format de certaines cellules change après application du code (Certaines cellules passent en date d'autres en standard pour le même type de données et la même colonne)

Comment puis je éviter cela ?

2 - Je ne peux pas lancer plusieurs fois la commande. J'ai une erreur Incompatibilité de Type '13' sur



Peut-être Est-ce dû au changement de format de cellule après le lancement de la commande ?

Merci

[RyuAutodidacte]

Bonsoir,

PS : comme en ce moment j'ai pas mal de taf, je ne pourrais répondre qu'en détail le soir !

Pour la 1ère question, je ne suis pas encore tombé sur le cas, il me faudrait un exemple concret, un fichier xlsx (donc sans macro) avec de fausses données mais où le cas est reproductible !
afin que je puisse tester …

(Certaines cellules passent en date d'autres en standard pour le même type de données et la même colonne)

Il faudrait être plus précis stp, … ?

En me basant sur l'exemple du post initial (en supposant qu'en plus de la colonne 4 on doit additionner la colonne 2) dont les critères d'additions seraient la colonne 1 et 3,
voilà le résultat (PS : je peux relancer le code sans problème) :

Nom	emplacement	Ref Article Host	Stock total
NESPRESSO	1	DULSAO	706
NESPRESSO	2	ARPEGGIO	1 454
NESPRESSO	1	ROMA	642
NESPRESSO	1	CAFEZIN	1 549
NESPRESSO	1	LINIZIO	411
NESPRESSO	1	CAPRICIO	216
NESPRESSO	3	VOLLUTO	1 728
NESPRESSO	1	RISTRETO	672
NESPRESSO	1	FORTIZIO310517	576
NESPRESSO	1	KAZAAR310517	324
NESPRESSO	4	VIVALTO	71 090
NESPRESSO	1	UMUTIMA3	776
NESPRESSO	1	TANIM311016	1 440

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
Sub StockCafe()Dim cLig As New Collection, c As Byte, L&, R&, VA, VR, X
    With Feuil1
        VA = .UsedRange.Value
        ReDim VR(1 To UBound(VA) - 1, 1 To 4)
        ReDim X(1 To UBound(VA) - 1) 'Tableau des critères pour addition
    For R& = 2 To UBound(VA)
            X(R - 1) = VA(R, 1) & "|" & VA(R, 3) 'Enregistrement des critères dans le tableau des colonnes 1 et 3
            On Error Resume Next
            L = cLig(X(R - 1))
            On Error GoTo 0
        If L Then
            VR(L, 2) = VR(L, 2) + VA(R, 2) 'Addition en col 2
            VR(L, 4) = VR(L, 4) + VA(R, 4) 'Addition en col 4
        Else
            L = cLig.Count + 1
            cLig.Add L, X(R - 1)
            For c = 1 To 4:  VR(L, c) = VA(R, c):  Next
        End If
                L = 0
    Next
        If cLig.Count < UBound(VR) Then
            .Range("A2:D2").Resize(cLig.Count).Value = VR 'Copie du tableau épuré des doublons additon faite
            .Rows(cLig.Count + 2 & ":" & UBound(VA)).Delete 'Effacement des lignes en supp
        End If
    End With
Set cLig = Nothing
End Sub

L'avantage du code c'est qu'il est facilement adaptable de 1 à x critères;
Imaginons que l'on a 2 références de nom identique mais pas de même marques, en précisant les critères en concaténation on pourra faire le distinguo afin d'avoir les bonnes correspondances pour additionner !

Pour la 2ème question :

Je ne peux pas lancer plusieurs fois la commande. J'ai une erreur Incompatibilité de Type '13' sur

je ne rencontre pas le problème, il faut vérifier le code que tu as adapté selon le contexte, c-à-d, selon la structure de tes données où tu as appliqué le code.

[froutloops62]

Merci Ryu,

Voici, en pièce joint le fichier.

Le critère doit être en colonne 4 et les 2 tris en colonnes 7 et 9

Pour éviter le problème, je force le format au début de mon code mais bon ce n'est pas très propre.

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
Sub Stock()
 
Dim cLig As New Collection, c As Byte, L&, R&, VA, VR, X
Dim DerLig As Long
    With Feuil1
        DerLig = .UsedRange.Rows.Count
        Range("A2:A" & DerLig).Select
    Selection.NumberFormat = "@"
        Range("B2:B" & DerLig).Select
    Selection.NumberFormat = "@"
        Range("C2:C" & DerLig).Select
    Selection.NumberFormat = "@"
        Range("D2:D" & DerLig).Select
    Selection.NumberFormat = "@"
        Range("E2:E" & DerLig).Select
    Selection.NumberFormat = "@"
        Range("F2:F" & DerLig).Select
    Selection.NumberFormat = "@"
        Range("G2:G" & DerLig).Select
    Selection.NumberFormat = "#,##0"
        Range("H2:H" & DerLig).Select
    Selection.NumberFormat = "@"
        Range("I2:I" & DerLig).Select
    Selection.NumberFormat = "0"
        Range("J2:J" & DerLig).Select
    Selection.NumberFormat = "m/d/yyyy"
        Range("K2:K" & DerLig).Select
    Selection.NumberFormat = "m/d/yyyy"
 
        VA = .UsedRange.Value
        ReDim VR(1 To UBound(VA) - 1, 1 To 11)
        ReDim X(1 To UBound(VA) - 1) 'Tableau des critères pour addition
    For R& = 2 To UBound(VA)
            X(R - 1) = VA(R, 4) 'Enregistrement des critères dans le tableau des colonne 4
            On Error Resume Next
            L = cLig(X(R - 1))
            On Error GoTo 0
        If L Then
            VR(L, 7) = VR(L, 7) + VA(R, 7) 'Addition en col 7
            VR(L, 9) = VR(L, 9) + VA(R, 9) 'Addition en col 9
        Else
            L = cLig.Count + 1
            cLig.Add L, X(R - 1)
            For c = 1 To 11:  VR(L, c) = VA(R, c):  Next
        End If
                L = 0
    Next
        If cLig.Count < UBound(VR) Then
            .Range("A2:K2").Resize(cLig.Count).Value = VR 'Copie du tableau épuré des doublons additon faite
            .Rows(cLig.Count + 2 & ":" & UBound(VA)).Delete 'Effacement des lignes en supp
        End If
    End With
Set cLig = Nothing
 
 
End Sub

[RyuAutodidacte]

Bonjour,

Ton problème se situe comme tu le dis dans le mot clé "Format".
Mais c'est en fait un faux problème.
Ce qu'il faut savoir, c'est que, quand tu laisses le format "standard" dans tes cellules, au moment où tu vas copier des données, le format va s'adapter automatiquement selon les données.
Exemple : si tu as un code en 0034837 sur une cellule au format standard, cela veut dire que le code a été forcé en texte bien que l'on soit en standard.
on peut le vérifier en écrivant le même code dans un cellule vide au format standard, on aura automatiquement 34837. Donc si l'on veut que le code reste en 0034837,
il faut mettre la colonne au format texte, car sinon un simple copier coller avec le format standard va mettre automatiquement le format par défaut :
- les chiffres => Nombre
- les dates => Date

Attention pour les dates où c'est plus particulier car elles dépendent du formatage de tes cellules et des options régionales. (pb d'inversion entre les jours et les mois)
Dans ton fichier on voit que les dates sont ferrées à gauche, or si tu créé un nouveau fichier et que tu écris une date quelconque, tu verras que celle-ci est ferrée à droite.
C'est donc que le formatage n'est pas tout à fait conforme.

Donc pour remédier à tout cela point de code supplémentaire, mais prendre 10 secondes pour régler le format des colonnes dans ton fichier :
- Colonne A à F mettre le format texte
- Colonne G, H et I on peut laisser en standard car il ne peut y avoir de confusion

-Colonne J et K il va falloir les convertir (mise à part la 1ère cellule) :
Dans "Données" faire "Convertir" (on peut laisser en "Délimité" mais de toute manière, c'est pas l'étape qui nous intéresse),
faire suivant
(on passe aussi l'étape pour le choix des séparateur donc pas besoin d'en sélectionner)
faire suivant
on arrive à l'étape qui nous intéresse (celle qui définit le format) : 1- sélectionner "DATE". 2- sélectionner "JMA" (on laise la destination par défaut) 3- on appuie sur "Fin"
et là on devrait avoir le bon formatage il suffit alors juste d'appliquer le code (sans ajout supplémentaire de code pour le formatage)

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
Sub MesStocks()
Dim cLig As New Collection, c As Byte, L&, R&, VA, VR, X
    With Sheets("Feuil1")
        VA = .UsedRange.Value
        ReDim VR(1 To UBound(VA) - 1, 1 To 11)
        ReDim X(1 To UBound(VA) - 1) 'Tableau des critères pour addition
    For R& = 2 To UBound(VA)
            X(R - 1) = VA(R, 4) 'Enregistrement des critères dans le tableau des colonnes 4
            On Error Resume Next
            L = cLig(X(R - 1))
            On Error GoTo 0
        If L Then
            VR(L, 7) = VR(L, 7) + VA(R, 7) 'Addition en col 7
            VR(L, 9) = VR(L, 9) + VA(R, 9) 'Addition en col 9
        Else
            L = cLig.Count + 1
            cLig.Add L, X(R - 1)
            For c = 1 To 11:  VR(L, c) = VA(R, c):  Next
        End If
                L = 0
    Next
        If cLig.Count < UBound(VR) Then
            .Range("A2:K2").Resize(cLig.Count).Value = VR 'Copie du tableau épuré des doublons additions faites
            .Rows(cLig.Count + 2 & ":" & UBound(VA)).Delete 'Effacement des lignes en supp
        End If
    End With
Set cLig = Nothing
End Sub

je n'ai pas eu d'erreur en ré appliquant le code

Edit : Fais moi savoir si tout est OK ou si j'ai omis 1 ou 2 points

[froutloops62]

Un grand Merci Riy, tout fonctionne !

[RyuAutodidacte]

C'est cool

N'oublie pas quelque soit les discussions de noter par un (en bas à droite) les posts/réponses qui t'ont été utiles (même si c'est pas une discussion que tu as ouverte), c'est un bon indicateur pour les forumeurs, et ca fait toujours plaisir que certaines de nos réponses peuvent être utiles