Discussion :

[Looper123]

Bonjour tout le monde,

J'essaie de créer une macro qui agit sur mon fichier ci-joint,
L'idée c'est de créer une nouvelle feuille pour chaque container et la nommer au nom du container ensuite faire une copie de tous les éléments du container pour les coller dans cette nouvelle feuille tout en supprimant les doublons et sommer les valeurs des doublons.
Exemple : container A : item: 1 - Qtt: 2
item: 1 - Qtt: 1
item: 2 - Qtt: 4
il affiche: item: 1 - Qtt : 3 et item: 2 - Qtt : 4 dans une nouvelle feuille nommée A.

Je vous remercie infiniment pour votre aide.Classeur1.xlsx

[ARTURO83]

Bonjour,

Voici, quelques éléments "indéterminés" reste en fond de feuille, libre à vous de les conserver ou de les supprimer.

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
74
Dim f1, f2
Dim DerLig_L As Long, DerLig_C As Long
 
Sub Creation_Feuille_Container()
    Application.ScreenUpdating = False
    Set f1 = Sheets("Liste")
    DerLig_L = f1.[D100000].End(xlUp).Row
    Formule_Recup_Nom_Container
    Filtrer_Container
    f1.Columns(6).ClearContents
    Set f1 = Nothing
End Sub
 
Sub Formule_Recup_Nom_Container()
    Range("F4:F" & DerLig_L).FormulaR1C1 = "=IF(RC[-5]=""Container No:"",RC[-3],IF(RC[-5]=""Seal No       :"",R[-1]C[-3],IF(AND(R[-1]C="""",OR(R[-2]C[-1]=""Description"",R[-1]C[-1]=""Description"")),R[-3]C[-3],R[-1]C)))"
    Range("F4:F" & DerLig_L).Value = Range("F4:F" & DerLig_L).Value
End Sub
 
Sub Filtrer_Container()
    ActiveSheet.AutoFilterMode = False
    Range("F4").Select
    If f1.AutoFilterMode Then
        isOn = "On"
    Else
        isOn = "Off"
        Selection.AutoFilter
    End If
 
    For Each C In f1.Range("F4:F" & DerLig_L)
        On Error Resume Next
        If f1.Cells(C.Row, "F") <> f1.Cells(C.Row - 1, "F") Then
            f1.Range("A3:F" & DerLig_L).AutoFilter Field:=6, Criteria1:=C.Text
            f1.Range("_FilterDataBase").Resize(, 11).SpecialCells(xlCellTypeVisible).Copy
            If Err.Number = 0 Then
                Sheets.Add(After:=Worksheets(Worksheets.Count)).Name = C.Text
                Set f2 = Sheets(ActiveSheet.Name)
                [A1].Select
                ActiveSheet.Paste
                DerLig_C = f2.[D100000].End(xlUp).Row
                Tri
                Formule_Somme_quantités
                Suppression_Doublons
            End If
            On Error GoTo 0
        End If
        f1.ShowAllData
        Set f2 = Nothing
    Next C
End Sub
 
Sub Tri()
    Range("A5:L" & DerLig_C).Sort [D5], 1
End Sub
 
Sub Formule_Somme_quantités()
    Range("L5:L" & DerLig_C).FormulaR1C1 = "=SUMIF(C4,RC4,C8)"
    Range("L5:L" & DerLig_C).Value = Range("L5:L" & DerLig_C).Value
End Sub
 
Sub Suppression_Doublons()
    Cells.Select
    ActiveSheet.Range("A5:L" & DerLig_C).RemoveDuplicates Columns:=4, Header:=xlYes
    Range("H5:H" & DerLig_C).Value = Range("L5:L" & DerLig_C).Value
    Columns("F:K").Delete
    [F4] = "Q'ty" & Chr(10) & "(PCS)"
End Sub
 
Sub Supprimer_Feuilles_Containers()
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    For i = Sheets.Count To 1 Step -1
        If Sheets(i).Name <> "Liste" Then Sheets(i).Delete
    Next
End Sub

Avec le fichier
Pièce jointe 466395

Cdlt

[mercatog]

Bonjour
Une TCD est fait pour ça en 2coups de souris

[ARTURO83]

Bonjour Mercatog,

"Un TCD est fait pour ça"
OK, à condition que les données soient dans un tableau bien structuré et là ce n'est absolument pas le cas, il s'agit probablement de données issues d'une extraction d'une autre application donc, avant de faire quoique ce soit il m'a semblé nécessaire de faire une mise en forme pour rendre tout ça exploitable. De plus, Looper123 à bien précisé qu'il voulait le résultat dans des feuilles séparées.

A moins de n'avoir pas tout compris, mais attendons l'avis de Looper123.

CDlt

[blackdarara]

Bonjour,

Bien qu'il soit possible de la faire avec un Tcd, j'aimerai savoir s'il serai possible de faire la sommes de valeur ayant pour critère chaque doublon puis de renseigner sur une colonne distincte une information en fonction du résultat.
j'avoue ne pas du tout savoir comment aborder ce problème. J'ai essayé de comprendre le code de ARTHUR083 mais sans résultat. Pouvez-vous m'aider svp ?

Vous trouverez ci-joint le fichier de départ et le résultat attendu.

Je vous remercie

[boisgontierjacques]

Bonjour,

Code :

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

1
2
3
4
5
6
7
8
9
10
11
12
Sub Recap()
  Set f = Sheets("feuil1")
  Set result = Sheets("feuil2").Range("A2")
  Set Dico = CreateObject("Scripting.Dictionary")
  TblBD = f.Range("D8:H" & f.[D65000].End(xlUp).Row)
  For i = 1 To UBound(TblBD)
    If TblBD(i, 1) <> "" And TblBD(i, 1) <> "TOTAL (CFR)" And IsNumeric(TblBD(i, 5)) Then Dico(TblBD(i, 1)) = Dico(TblBD(i, 1)) + TblBD(i, 5)
  Next i
  result.CurrentRegion.Offset(1).ClearContents
  result.Resize(Dico.Count, 1) = Application.Transpose(Dico.Keys)
  result.Offset(, 1).Resize(Dico.Count, 1) = Application.Transpose(Dico.Items)
End Sub

Boisgontier

[Pierre Fauconnier]

Salut

[...]
OK, à condition que les données soient dans un tableau bien structuré et là ce n'est absolument pas le cas[...]

Dans ce cas, la première chose à faire, puisqu'on est en Excel, est de remettre les données dans une configuration qui permet d'utiliser les outils d'Excel. Excel propose des outils pour supprimer les doublons, des fonctions pour dénombrer et sommer à peu près n'importe quoi, et parce que les données ne sont pas bien organisées, on s'oblige à utiliser du code (qui de l'aveu même du demandeur n'a pas été compris par lui), alors que peu de code peut remettre les données d'équerre pour utiliser les outils d'Excel. De plus, la demande initiale peut être réalisée, depuis XL2010 (tag de version utilisé ici), grâce à Power Query sans VBA

Ici, on utilise un dico et du code VBA, qui plus est date de 2003^*,alors que l'on pourrait se contenter d'un code simple et compréhensible. C'est un non-sens, pour moi.


^* C'est aberrant, en 2019, d'encore proposer TblBD = f.Range("D8:H" & f.[D65000].End(xlUp).Row) alors que cela fait 12 ans qu'on est passé à 1048576 lignes et que les tableaux structurés permettent d'éviter de jouer avec du code qui contraint à l'utilisation d'une feuille et d'une colonne particulière de cette feuille. Si on déplace les données ailleurs sur la même feuille ou sur une autre feuille, le code que je cite va planter alors qu'on a tout ce qu'il faut en magasin pour écrire du code solide et pérenne grâce, notamment, aux tableaux structurés

[Pierre Fauconnier]

De plus, la demande initiale peut être réalisée, depuis XL2010 (tag de version utilisé ici), grâce à Power Query sans VBA