Bonjour,

Je voudrais faire une macro pour réaliser le besoin suivant :

J’ai un tableau avec possiblement plusieurs centaines de ligne, et pas classer.

Colonne A : désignation

Colonne B : fabricant

Colonne C : référence

Colonne D : Numéro CAS

Colonne E : état physique

Colonne F : Quantité

Colonne G : Unité

Si deux valeurs ou plus dans la colonne D sont identiques sauf si ces valeurs sont 0 ou 9, et que pour ces valeurs en doublon les valeurs dans la colonne G sont identiques, alors créer une nouvelle ligne sous les doublons, la mettre en gras copier les informations des doublons des colonnes A, D, E, G et dans la colonne F faire la somme des colonnes F en doublons.

Exemple :

- Ligne 11 et 12, Les cellules D11 et D12 sont identiques et les cellules G11 et G12 sont identiques

Donc je crée la ligne 13 (en gras), je copie les cellules A11 en A13, D11 en D13, E11 en D13, G11 en G13.

Je fais la somme de cellules F11 et F12 que je mets en F13

- Lignes 71 et 72, les cellules D71 et D72 sont identiques et les cellules G71 et G72 sont différentes

Donc je ne fais rien.

- dans mon exemple je n'ai que 2 lignes identiques, il peux y en avoir plus.

L'onglet actif est l'onglet "Produits"

Je essaye le code suivant (grâce à l'AI aussi) mais lors de l'exécution le fichier se ferme !!!

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
 
 
Sub GererDoublons()
    Dim ws As Worksheet
    Dim lastRow As Long
    Dim i As Long
    Dim newRow As Long
    Dim dict As Object
    Dim key As String
    Dim doublons As Collection
 
    ' Définir la feuille de calcul active
    Set ws = ActiveSheet
 
    ' Trouver la dernière ligne utilisée dans la colonne A
    lastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
 
    ' Initialiser un dictionnaire pour stocker les doublons
    Set dict = CreateObject("Scripting.Dictionary")
 
    ' Parcourir les lignes du tableau
    For i = 2 To lastRow
        ' Vérifier que la valeur de la colonne D n'est pas 9 ou 0
        If ws.Cells(i, "D").Value <> 9 And ws.Cells(i, "D").Value <> 0 Then
            ' Créer une clé basée sur Colonne D et Colonne G
            key = ws.Cells(i, "D").Value & "_" & ws.Cells(i, "G").Value
 
            ' Vérifier si la clé existe déjà
            If dict.exists(key) Then
                dict(key).Add i
            Else
                Set doublons = New Collection
                doublons.Add i
                dict.Add key, doublons
            End If
        End If
    Next i
 
    ' Traiter les doublons trouvés
    For Each key In dict.Keys
        If dict(key).Count > 1 Then
            ' Insérer une nouvelle ligne sous les doublons
            newRow = dict(key).Item(dict(key).Count) + 1
            ws.Rows(newRow).Insert Shift:=xlDown
 
            ' Copier les informations des doublons
            ws.Cells(newRow, "A").Value = ws.Cells(dict(key).Item(1), "A").Value
            ws.Cells(newRow, "D").Value = ws.Cells(dict(key).Item(1), "D").Value
            ws.Cells(newRow, "E").Value = ws.Cells(dict(key).Item(1), "E").Value
            ws.Cells(newRow, "G").Value = ws.Cells(dict(key).Item(1), "G").Value
 
            ' Calculer la somme des valeurs en colonne F
            Dim somme As Double
            somme = 0
            For Each i In dict(key)
                somme = somme + ws.Cells(i, "F").Value
            Next i
            ws.Cells(newRow, "F").Value = somme
 
            ' Mettre la nouvelle ligne en gras
            ws.Rows(newRow).Font.Bold = True
        End If
    Next key
 
End Sub