problème de macro

[michaeldms]

Bonjour je n'arrive pas à comprendre pourquoi cette macro ne fonctionne pas :

Code :

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
Sub test()
Dim i As Long, j As Long, x As String
 
Application.ScreenUpdating = False
 
With Sheets(1) '<-- nom ou position de la feuille à adapter
    For i = .Cells(Rows.Count, 1).End(xlUp).Row To 2 Step -1
        x = .Cells(i, 1) & .Cells(i, 2) & .Cells(i, 3)
        For j = i - 1 To 1 Step -1
            If .Cells(j, 1) & .Cells(j, 2) & .Cells(j, 3) = x Then
                If .Cells(j, 4) < .Cells(i, 4) Then
                    .Rows(j).Delete
                Else
                    .Rows(i).Delete
                    Exit For
                End If
            End If
        Next j
    Next i
End With
 
Application.ScreenUpdating = True
 
End Sub

Elle a pour but sur plusieurs lignes où les 3 premières colones sont les mêmes de garder que la ligne où la colone 4 est supérieure et de supprimer les deux autres.

[dave92]

Bonjour,

Voici u ne solution alternative

Code :

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
 
Sub test()
Dim i As Long, j As Long, x As String
Dim CurLig As Long
Dim CurX As String
    Application.ScreenUpdating = False
    With Sheets(1)
        CurLig = 1  '<-1ère ligne du tableau (hors éventuelle ligne d'entête)
        CurX = .Cells(CurLig, 1) & .Cells(CurLig, 2) & .Cells(CurLig, 3)
        i = CurLig + 1
        While .Cells(i, 1).Value <> vbNullString
            x = .Cells(i, 1) & .Cells(i, 2) & .Cells(i, 3)
            If x = CurX Then
                If .Cells(i, 4).Value < .Cells(CurLig, 4).Value Then
                    .Rows(i).Delete
                Else
                    .Rows(CurLig).Delete
                    CurLig = i - 1
                    CurX = .Cells(CurLig, 1) & .Cells(CurLig, 2) & .Cells(CurLig, 3)
                End If
 
            Else
                CurLig = i
                CurX = .Cells(CurLig, 1) & .Cells(CurLig, 2) & .Cells(CurLig, 3)
                i = i + 1
            End If
        Wend
    End With
    Application.ScreenUpdating = True
End Sub

[gFZT82]

Bonjour,

Pourquoi dis-tu que ta macro ne fonctionne pas ?
- tu n’obtiens pas le résultat attendu ?
- le code génère une erreur ?

Je l’ai testé sur quelques lignes et il a bien réalisé le traitement indiqué (sur les lignes contigües).

Cordialement.

[michaeldms]

Bonjour,

En fait elle me supprime des lignes qui ne devraient pas être supprimées. j'ai fais plusieur test et c'est toujours le cas.

[gFZT82]

Bonjour,

Ta procédure supprime une ligne si la condition suivante est satisfaite :

Code :

.Cells(i, 1) & .Cells(i, 2) & .Cells(i, 3) = .Cells(j, 1) & .Cells(j, 2) & .Cells(j, 3)

Tu indiques :

Elle a pour but sur plusieurs lignes où les 3 premières colonnes sont les mêmes de ne garder que la ligne où la colonne 4 est supérieure et de supprimer les deux autres.

En fait, elle ne supprime pas que les "deux autres" mais toutes les autres qui satisfont la condition.

Autre piste, si les cellules des 3 premières colonnes sont vides, la condition est satisfaite.

As-tu vérifié le contenu des 3 premières colonnes des lignes qui sont effacées alors qu’elles ne le devraient pas ?

Cordialement.