Probleme en VBA pour supprimer les deux ligne

yanly -  
 Utilisateur anonyme -
Bonjour à tous,
J’ai écrit un programme en VBA (Excel), j’essais de supprimer les lignes qui contiennes des données identiques. (La méthode que j’utilise et une comparaison de deux colonnes B et C)

Pouvez-vous m’aider à trouver la solution SVP

Merci de votre aide


Sub Delete_Double_Linges_3()

Dim Projet1 As Range
Dim Phase1 As Range

Dim Projet1_line_suivante As Range
Dim Phase2_line_suivante As Range

Dim lines As Integer


' Un tri sur la colonne D3 (Date)

Worksheets("Courant-1").Range("D3").Sort _
Key1:=Worksheets("Courant-1").Range("D3"), _
Order1:=xlDescending, Header:=xlGuess

Set Projet1 = Sheets("Courant-1").Cells(1, 2)
Set Phase1 = Sheets("Courant-1").Cells(1, 3)


lines = 1

Lines_Suivante:


Do While Not IsEmpty(Projet1)
lines = lines + 1

Set Projet1_line_suivante = Sheets("Courant-1").Cells(lines, 2)

Set Phase1_line_suivante = Sheets("Courant-1").Cells(lines, 3)


If Projet1.Value = Projet1_line_suivante.Value And Phase1.Value = Phase1_line_suivante.Value Then

Projet1.EntireRow.Delete

GoTo Lines_Suivante


End If

Projet1 = Projet1_line_suivante
Phase1 = Phase1_line_suivante
GoTo Lines_Suivante


Loop

End Sub
A voir également:

2 réponses

Réponse 1 / 2
Utilisateur anonyme
 
Bonjour,

Je n'utilise jamais l'instruction [ GoTo ] dans une procédure, mais je puis vous proposer
une autre méthode !

Suggestion : 

Option Explicit

Type Donnees
    Col1 As Variant
    Col2 As Variant
End Type
'

Sub Supprime_Lignes_Doublons()

    Dim Boucle As Integer, Limite As Integer, Bte As Donnees
    Dim Position As String
    
    Range("B2").Select
    Limite = Range("B2:B65536").End(xlDown).Row
    For Boucle = 0 To (Limite - 1)
        Bte.Col1 = ActiveCell.Offset(0, 0).Value
        Bte.Col2 = ActiveCell.Offset(0, 1).Value
        
        ActiveCell.Offset(1, 0).Select
        Position = ActiveCell.Address
        While (ActiveCell.Offset(0, 0).Value <> "")
            If ((ActiveCell.Offset(0, 0).Value = Bte.Col1) And _
                (ActiveCell.Offset(0, 1).Value = Bte.Col2)) Then
                ActiveCell.EntireRow.Delete
                Limite = (Limite - 1)
                If (Limite < 0) Then
                    Limite = 0
                End If
            Else
                ActiveCell.Offset(1, 0).Select
            End If
        Wend
        Range(Position).Select
    Next Boucle
    Range("A1").Select
    
End Sub
'


Lupin
0
Probleme deux lignes
 
Bonjour Lupin,
Je voulais vous remercier pour votre réponse car elle est excellente !!!!
Je suis désolé si mon style n'est pas à la hauteur car je suis nouveau dans ce domaine….
Par contre j'admire beaucoup votre style, c'est un style très poussé pour moi.
Il faudrait encore qq jours pour comprendre ce que vous avez fait (en tout cas pour moi).
Je vous souhaite un très bon W.K.

Bye Bye
0
Réponse 2 / 2
Utilisateur anonyme
 
re :

vous savez, chaque programmeur développe son propre style,
vous n'avez pas a être désolé, pour ma part, c'est un plaisir
de partager, mais il est vrai que j'ai tendance a avoir une
critique plutôt sévère mais constructive à mon avis !

Je vous dirai à mon tour que j'admire votre style de communication,
j'en ai certe déjà appris de vous.

Arsène Lupin
Gentleman
Pour vous servir
0

Discussions similaires

Supprimer conversation messenger pour tout le monde
mercidemaider -
sd -

7 réponses
Supprimer conversation Facebook chez destinataire
Alastorn -
Manal -

3 réponses
Effacer les conversations sur messenger
Marie-Ange1948 -
c_myriam06 -

4 réponses
Impossible de "retirer"mes messages sur Messenger
Sab -
Sab -

8 réponses