Probleme en VBA pour supprimer les deux ligne

Question

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

Utilisateur anonyme · Answer

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

Utilisateur anonyme · Answer

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

Probleme en VBA pour supprimer les deux ligne

2 réponses

Discussions similaires

Newsletters