Discussion :

[nicdodo]

Bonjour, 1 semaine que je me casse la tete sur un probleme, donc je viens encore vers ce forum
j'ai une feuille facture avec un bouton enregistré. Quand j'appuis dessus, une macro me copie les donées dans la 1er ligne vide de la colonne A d'une autre feuille nommée "LISTE PRODUITS"
Cette feuille correspond à tous les produits commandés qui s'ajoutent les uns apres les autres dans ma colonne A
Je retrouve donc en fin de journée avec sur ma feuille "liste produits" une colonne A avec jusqu'a 500 lignes de produits qui peuvent etre soit idnetiques soit différents
Mon probleme consiste à trier et grouper les produits similaires:
J'aimerai faire une macro qui me permette quand je clique sur un bouton de :
- trier ma colonne A par odre alphabétique
- efface les données similaires en me marquant dans la colonne B à coté le nombre de produits similaires.

EXEMPLE
Avant tri :
A / B
coca
fanta
orangina
coca

Apres tri :
A / B
coca / 2
fanta / 1
orangina / 1

regrouper par ordre alphabétique n'est pas un probleme j'utilise :

Code :

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

1
2
3
4
5
6
7
8
Sub listeproduit()
 
 Range("A2:A500").Select
 
 Selection.Sort Key1:=Range("A2"), Order1:=xlAscending, Header:=xlGuess, _
 OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
 DataOption1:=xlSortNormal
 End Sub

mais apres grouper les doublons et marqué le nombre de termes identiques ou uniques dans la colonne B je bloque
Pouvais vous m'aider svp
cordialement

[Invité]

Bonjour

Je te conseil la lecture d'un tuto où tu y trouveras une bonne partie de tes réponses : La gestion des doublons dans Excel

Philippe

[Theze]

Bonjour,

Regarde si ça convient et adapte. Fait le test sur une copie de ton classeur :

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
 
Sub ListeProduits()
 
    Dim Fe As Worksheet
    Dim Plage As Range
    Dim Cel As Range
    Dim Dico As Object
    Dim ListeCle As Variant
    Dim ListeElement As Variant
    Dim I As Long
 
    Set Fe = Worksheets("Liste Porduits")
 
    With Fe
 
        'défini la plage pour chaque feuille (ici, de A1 à A?)
        Set Plage = .Range(.Cells(1, 1), .Cells(.Rows.Count, 1).End(xlUp))
 
    End With
 
    'tri ascendant
    Plage.Sort Plage.Columns(1), xlAscending
 
    'crée le dico
    Set Dico = CreateObject("Scripting.Dictionary")
 
    'si unique, récup de la valeur sinon, incrémente de 1
    For Each Cel In Plage
 
        If Dico.exists(Cel.Value) = False Then
 
            Dico.Add Cel.Value, 0
 
        Else
 
            Dico.Item(Cel.Value) = Dico.Item(Cel.Value) + 1
 
        End If
 
    Next Cel
 
    'récup des clés et éléments
    ListeCle = Dico.Keys
    ListeElement = Dico.Items
 
    'vide la plage
    Plage.Clear
 
    'et réinscrit les valeurs unique avec en colonne B le nombre de doublons
    For I = 0 To Dico.Count - 1
 
        Range("A" & I + 1) = ListeCle(I)
 
        If ListeElement(I) > 0 Then Range("B" & I + 1) = ListeElement(I)
 
    Next I
 
End Sub

Hervé.

[nicdodo]

Merci Philippe,
j'étais deja allé sur ce tuto, j'avais essayé mais ça ne marchait pas. C'était ma faute, surmeent trop dans mon probleme et pas assez de recul.
J'ai suivi ton conseil et grace à l'enregistreur de macro j'ai pu faire ce que je voulais, toutefois je pense que la maniere de faire n'est pas super orthodoxe.

En gros j'ai mes produits qui s'affichent en vrac dans la colonne A
puis j'utilise les fonctions
=(INDEX($A:$A;MIN(SI(NB.SI(F$1:F1;$A$1:$A$100)=0;LIGNE($A$1:$A$100))))&"") dans la colonne F
et
=SI(F2<>"";NB.SI(A:A;F2);"") dans ma colonne G

Ensuite je fais un copier coller spécial en valeur de F3:G300 vers J2
je tri ce que j'ai coller dans l'ordre décroissant à cause de mes cellules vides
Puis j'efface toute mes données de A2:G500
je copie colle mon tableau en J2 vers A2
et enfin j'efface toutes mes données en C2:K300

ce qui nous donne en macro

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
Sub listeproduits()
Range("F2").Select
    Selection.FormulaArray = _
        "=(INDEX(C1,MIN(IF(COUNTIF(R1C:R[-1]C,R1C1:R100C1)=0,ROW(R1C1:R100C1))))&"""")"
    Selection.AutoFill Destination:=Range("F2:F300"), Type:=xlFillDefault
    Range("F2:F300").Select
    ActiveWindow.SmallScroll Down:=-303
    Range("G2").Select
    Selection.FormulaArray = "=IF(RC[-1]<>"""",COUNTIF(C[-6],RC[-1]),"""")"
    Selection.AutoFill Destination:=Range("G2:G300"), Type:=xlFillDefault
    Range("G2:G300").Select
    Range("F3:G300").Select
    Selection.Copy
    Range("J2").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("A2:G300").Select
    Range("G300").Activate
    Application.CutCopyMode = False
    Selection.ClearContents
    Range("J2:K300").Select
    Range("K300").Activate
    ActiveWorkbook.Worksheets("LISTE PRODUITS").Sort.SortFields.CLEAR
    ActiveWorkbook.Worksheets("LISTE PRODUITS").Sort.SortFields.Add Key:=Range( _
        "J3:J300"), SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:= _
        xlSortNormal
    With ActiveWorkbook.Worksheets("LISTE PRODUITS").Sort
        .SetRange Range("J2:K300")
        .Header = xlYes
        .MatchCase = True
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    Selection.Copy
    ActiveWindow.SmallScroll Down:=-291
    Range("A2").Select
    ActiveSheet.Paste
    Range("G2:K393").Select
    Application.CutCopyMode = False
    Selection.ClearContents
    Range("D9").Select
End Sub

Apres j'ai un autre bouton qui m'imprime et me remet toues les valeures de ma feuille comme avant
Voila c'est pas tres tres joli je pense pour des pro, mais ça marche, je mets résolu, mais si y'a des solutions pour m'éviter tous ces copier coller je suis preneur
Encore merci

[nicdodo]

Merci Theze,
ton code efface effectivement les doublons, me met un chiffre dans la colonne B
mais il ne me mets pas le nombre de doublons et il m'efface la 1er ligne
C'est à dire si j'ai

A / B
PRODUIT /
coca /
fanta /
orangina /
coca /

quand j'utilise ton code ça va faire

A / B
coca / 1
fanta / 1
orangina / 1

au lieu de

A / B
PRODUITS /
coca / 2
fanta / 1
orangina / 1