Discussion :

[Nebrawk]

Bonjour,

J'ai une macro qui fonctionne mais j'aimerai supprimer les lignes en doublons quand ces lignes n'appartiennent pas au même sous ensemble.
Je m'explique, j'ai déjà un bout de macro qui supprime mes doublons en fonction de plusieurs critères (colonne). Cependant il est possible que des doublons aient été supprimés alors qu'ils n'appartiennent pas au même sous ensemble (.1 ; ..2 ; etc).

Exemple simple :
.1 Bride
..2 Partie 1 bride
...3 Vis
..2 Partie 2 bride
...3 Vis

Il s'agit d'un découpage de pièces pour fabrication. Dans l'exemple si j'applique ma macro, les vis de la partie de bride 1 vont être supprimées et donc ne seront pas fabriquées. Il s'agit d'un fichier extrait de SAP je ne souhaite donc pas modifier le fonctionnement des sous ensembles.

Quelqu'un pourrait m'aider s'il vous plait?

[Nicolas JACQUIN]

Bonjour,
je pense que ta demande est mal formulée, pour ma part je n'est pas compris,
si tu as déjà commencé un code il serait sage de nous en faire profiter pour que l'on puisse t'accompagner dans ta démarche

[Nebrawk]

Je voudrais rajouter une condition qui permet de ne pas supprimer les faux doublons (même ligne exactement mais pas même sous ensemble de produit (cf. exemple).

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
 
Dim tabInt As Variant
Dim tabDon As Variant
Dim tabDoubl As Variant
Dim compt As Byte
 
Application.Calculation = xlCalculationManual
Application.ScreenUpdating = False
 
tabInt = ActiveWorkbook.Sheets("final").Cells(1, 1).CurrentRegion
ReDim tabDon(LBound(tabInt) To UBound(tabInt))
 
For I = LBound(tabInt) To UBound(tabInt)
    tabDon(I) = tabInt(I, varColRech1) & tabInt(I, varColRech2) & tabInt(I, varColRech3) 
 
Next I
 
ReDim tabDoubl(1 To 1)
compt = 0
 
Set AL = CreateObject("System.Collections.ArrayList")
With AL
 
    For I = LBound(tabDon) To UBound(tabDon)
        If Not .contains(tabDon(I)) Then
            .Add tabDon(I)
        Else
            If compt = 0 Then
                tabDoubl(1) = I
                compt = compt + 1
            Else
                ReDim Preserve tabDoubl(LBound(tabDoubl) To UBound(tabDoubl) + 1)
                tabDoubl(UBound(tabDoubl)) = I
            End If
        End If
    Next I
 
    If compt <> 0 Then
    For I = UBound(tabDoubl) To LBound(tabDoubl) Step -1
        ActiveWorkbook.Sheets("final").Rows(tabDoubl(I)).Delete
    Next I
End If
 
End With