Discussion :

[medsky74]

Bonjour,

voila, j'ai dans une feuille qui contient des données similaire
la 1er colonne "a" id un chiffre aléatoire si id<0 alors les colonnes de "f" à "aa" sont vides
la colonnes de "b" à "e" (qui contient jour, mois, année ,heure)

ma feuille de données contient une ou plusieurs lignes doublées par rapport a la colonne "b" à "e" mais pas nécessairement les autres colonnes, donc je dois supprimer les ligne doublées par rapport au colonnes "b" à "e" ceux qui ont la valeurs id de la colonne "a" négatif

A   B    C    D      E     F   G    H    I    J    K    L 
-1  1   1  2012    01 
10  1   1  2012    01   14  15   0   1   30  110   120
-1  2   1  2012    02  
-1  2   1  2012    02
15  2   1  2012    03   15   16  1   30  1    50    1
15  2   1  2012    03   15   16  1   30  1    50    1

Je dois retrouvée ceci :

A   B    C    D      E     F   G    H    I    J    K    L 
10  1   1  2012    01   14  15   0   1   30  110   120
-1  2   1  2012    02
15  2   1  2012    03   15   16  1   30  1    50    1

prière de bien vouloir m'aider par un code vba

merci et cordialement

[Daniel.C]

Bonjour,

Pourqui y a-t-il une ligne :

15 2 1 2012 03 15 16 1 30 1 50 1

supprimée alors que l'id est positif ?

[medsky74]

mais j'ai besoin de ces données sinon j'aurai pu faire un tris sur les valeurs négatives é je supprime le tout

même ceux qui on un id positif je peu trouver des doublons (comme c'est le cas ci-dessous)

15 2 1 2012 03 15 16 1 30 1 50 1
15 2 1 2012 03 15 16 1 30 1 50 1

[Daniel.C]

Code :

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

donc je dois supprimer les ligne doublées par rapport au colonnes "b" à "e" ceux qui ont la valeurs id de la colonne "a" négatif

Je comprends :

"donc je dois supprimer les ligne doublées par rapport au colonnes "b" à "e" si la valeur id de la colonne "a" est négative". Sinon, comment doit-on interpréter ta phrase ?

[medsky74]

oui c'est ça !! donc je dois supprimer les ligne doublées par rapport au colonnes ceux qui ont la valeurs id de la colonne "a" négatif mais aussi ceux qui on un id positif é la colonne "b" à "e" doubler
je suis dans le cas ou j'ai un doublon dans la colonne "b" à "e" mais des id différents (c'est à dire id >0 et id<0) (cas 1er é 2eme ligne)
mais je supprime la ligne qui a un id <0 puisque la colonne de "f" à "l" ne comporte pas d'information

A B C D E F G H I J K L
-1 1 1 2012 01
10 1 1 2012 01 14 15 0 1 30 110 120
-1 2 1 2012 02
-1 2 1 2012 02
15 2 1 2012 03 15 16 1 30 1 50 1
15 2 1 2012 03 15 16 1 30 1 50 1

Je dois retrouvée ceci lorsque j'élimine les doublons

A B C D E F G H I J K L
10 1 1 2012 01 14 15 0 1 30 110 120
-1 2 1 2012 02
15 2 1 2012 03 15 16 1 30 1 50 1

[Daniel.C]

Essaie :

Code :

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

1
2
3
Sub test()
    Sheets("Feuil1").[A1].CurrentRegion.RemoveDuplicates Columns:=Array(2, 3, 4, 5), Header:=xlNo
End Sub

[medsky74]

je ne dois pas supprimer les lignes doublons qui on un id >0 ((voir l'exemple en rouge)


A B C D E F G H I J K L
-1 1 1 2012 01
10 1 1 2012 01 14 15 0 1 30 110 120
-1 2 1 2012 02
-1 2 1 2012 02
15 2 1 2012 03 15 16 1 30 1 50 1
15 2 1 2012 03 15 16 1 30 1 50 1

Je dois retrouvée ceci lorsque j'élimine les doublons

A B C D E F G H I J K L
10 1 1 2012 01 14 15 0 1 30 110 120
-1 2 1 2012 02
15 2 1 2012 03 15 16 1 30 1 50 1

[Daniel.C]

Alors pourquoi :

15 2 1 2012 03 15 16 1 30 1 50 1
15 2 1 2012 03 15 16 1 30 1 50 1

devient :

15 2 1 2012 03 15 16 1 30 1 50 1

?

Si c'est le cas :

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
Sub test()
    Dim Plage As Range, C As Range
    With Sheets("Feuil1")
        Set Plage = .[A1].CurrentRegion.Resize(, 1)
        For Each C In Plage
            If C < 0 Then
                C.Offset(, 27) = 0
            Else
                C.Offset(, 27).Formula = "=ROW()"
            End If
        Next C
        Set Plage = Plage.Resize(, 28)
        Plage.Select
        Plage.RemoveDuplicates Columns:=Array(2, 3, 4, 5, 28), Header:=xlYes
        .Columns(28).Delete
    End With
End Sub

[medsky74]

Désolé de prendre un peu de votre temps, j'ai testé la procédure, elle ne fait rien !!

dans mon cas il y a trois cas situations à savoir

lorsque j'ai de doublons avec un id <0 et un id >0 avec des colonne doublées de "B" à "E" donc je dois supprimé la ligne doublé qui a un id<0

exemple
A B C D E F G H I J K L
-1 1 1 2012 01
10 1 1 2012 01 14 15 0 1 30 110 120
j'aurai
10 1 1 2012 01 14 15 0 1 30 110 120

2éme cas lorsque j'ai de doublons avec un id<0

exemple
A B C D E F G H I J K L
-1 2 1 2012 02
-1 2 1 2012 02
avec des colonne doublées de "B" à "E" donc je dois supprimé une seule ligne doublé

j'aurai
-1 2 1 2012 02

3éme cas lorsque j'ai de doublons avec un id>0

exemple
A B C D E F G H I J K L
15 2 1 2012 15 14 15 0 1 30 110 120
15 2 1 2012 15 14 15 0 1 30 110 120
avec des colonne doublées de "B" à "E" donc je dois supprimé une seule ligne doublé

j'aurai
15 2 1 2012 15 14 15 0 1 30 110 120

j'espère que j'été claire mnt

é désolée encore une fois

merci et salutations

[Daniel.C]

Je vais essayer, en espérant que tu ne changeras pas les règles encore une fois :

je ne dois pas supprimer les lignes doublons qui on un id >0 ((voir l'exemple en rouge)

[Invité]

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
Dim Doublon As Collection
Sub Scan()
Dim RowsSup() As Integer
Dim L As Long
Dim Linge As Long
Dim Myrange As Range
Const L_Start = 1 'L_Start=1 Si pas de titre de colonne L_Start=2 si titre de colone.
Set Doublon = New Collection
Set Myrange = ActiveSheet.Range("A1").CurrentRegion
 ReDim RowsSup(0)
For L = L_Start To Myrange.Rows.Count
    Linge = MethodeHighlander(L, Myrange)
    If Linge <> 0 Then
        ReDim Preserve RowsSup(1 + UBound(RowsSup))
        RowsSup(UBound(RowsSup)) = Linge
    End If
Next
For L = UBound(RowsSup) To 1 Step -1
    'Supp
Next
End Sub
Function MethodeHighlander(L As Long, Myrange As Range) As Long
'La Méthode Highlander il ne peut en rester qu'un.
Dim col As Integer
Dim Text As String
Text = ""
MethodeHighlander = 0
For col = 1 To Myrange.Columns.Count
    Text = Text & "_" & Myrange(L, col)
Next
On Error Resume Next
'On peut ajouter dans une collection un enregistrement en lui donnant un nom.
'Le problème est qu'elle ne supporte pas les doublons.
'On utilise les messages d'erreur pour définir les doublons.
Doublon.Add txt, "T_" & Text
If Err <> 0 Then
    MethodeHighlander = L
    Err.Clear
End If
On Error GoTo 0
End Function

[Daniel.C]

Vérifie :

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
Sub test()
    'Réf. 130203.xlsm
    Dim Plage As Range, C As Range, Ligne As Long
    With Sheets("Feuil1")
        Set Plage = .[A1].CurrentRegion.Resize(, 1)
        Ligne = Plage.Rows.Count
        For Each C In Plage
            C.Offset(, 27).Formula = "=COUNTIFS(" & Plage.Offset(, 1).Address & "," & .Cells(C.Row, 2).Address & "," & _
            Plage.Offset(, 2).Address & "," & .Cells(C.Row, 3).Address & "," & Plage.Offset(, 3).Address & _
            "," & .Cells(C.Row, 4).Address & "," & Plage.Offset(, 4).Address & "," & .Cells(C.Row, 5).Address & ")"
        Next C
        For i = Ligne To 1 Step -1
            If .Cells(i, 1) < 0 And .Cells(i, 28) > 1 Then
                .Cells(i, 1).EntireRow.Delete
            End If
        Next i
        Ligne = Plage.Rows.Count
        For i = Ligne To 1 Step -1
            If .Cells(i, 28) > 1 Then
                .Cells(i, 1).EntireRow.Delete
            End If
        Next i
        .Columns(28).Delete
    End With
End Sub

[medsky74]

Désolé j'ai essayé mais il ne ce passe rien

ci-joint le fichier excel avec l'exemple et la marco

merci

[Daniel.C]

Ci-joint ton classeur après exécution de la macro (la feuille initiale est renommée "Feuil2"). J'ai recopié les données sur "Feuil1" et exécuté la macro. Si tu as un problème avec les macros dis-le.

[Invité]

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
Dim Doublon As Collection
Sub Scan()
Dim RowsSup() As Integer
Dim L As Long
Dim Linge As Long
Dim MyRange As Range
Const L_Start = 1 'L_Start=1 Si pas de titre de colonne L_Start=2 si titre de colone.
Set Doublon = New Collection
Set MyRange = ActiveSheet.Range("A1").CurrentRegion
 ReDim RowsSup(0)
For L = L_Start To MyRange.Rows.Count
    Linge = MethodeHighlander(L, MyRange)
    If Linge <> 0 Then
        ReDim Preserve RowsSup(1 + UBound(RowsSup))
        RowsSup(UBound(RowsSup)) = Linge
    End If
Next
For L = UBound(RowsSup) To 1 Step -1
   DeleteRow ActiveSheet.Range(MyRange(RowsSup(L), 1).Address)
Next
End Sub
Function MethodeHighlander(L As Long, MyRange As Range) As Long
'La Méthode Highlander il ne peut en rester qu'un.
Dim col As Integer
Dim Text As String
Text = ""
MethodeHighlander = 0
For col = 1 To 4
    Text = Text & "_" & MyRange(L, col)
Next
On Error Resume Next
'On peut ajouter dans une collection un enregistrement en lui donnant un nom.
'Le problème est qu'elle ne supporte pas les doublons.
'On utilise les messages d'erreur pour définir les doublons.
Doublon.Add txt, "T_" & Text
If Err <> 0 Then
    MethodeHighlander = L
    Err.Clear
End If
On Error GoTo 0
End Function
Sub DeleteRow(MyRange As Range)
Dim DelRow As String
DelRow = CStr(MyRange.Row) & ":" & CStr(MyRange.Row)
Debug.Print DelRow
    ActiveSheet.Rows(DelRow).Delete Shift:=xlUp
 
 
End Sub

[medsky74]

Merci beaucoup Daniel et Robert