:-( Doublons De M.....

[BAT]

Bonjour à tous,

Je galère vraiment avec les doublons!

J'essaye de trouver un code VBA simple pour éliminer les lignes comportant une valeur en doublon dans la colonne "B"doublons de ma feuille.

Enfin je que la macro élimine une ligne sur les deux!

J'ai essayé plusierus code et là je craque !

Un petit coup de main serait le bienvenue

Merci d'avance de vos réponses !!

Bat

 

[Celeda]

Re : :-( Doublons De M.....

Bonjour,

En premier, il ne faut jamais injurier les doublons : on a toujours besoin d'un plus petit doublon chez soi !! lol!!

En second, tu aurais du placer ton code pour que les spécialists te disent ce qui clochait,

Et pour finir, je te refile un code (issu de l'appli DoublonsMacros) qui élimine toutes les lignes des doublons et justement ceux de la colonne B :



Option Explicit
Option Private Module

'http://www.excel-downloads.com/html/French/forum/messages/1_62749_62749.htm
'michelxld@yahoo.fr le 24.12.2003
'Doublons_Macros France Mars 2004
'=================================================================
'Module pour la feuille Suppression 2
'=================================================================
Sub SupprimerLignesDoublons()
Dim Cell As Range
Dim Ligne As Integer, I As Integer
Dim M As Byte, U As Byte, N As Byte
Dim Tableau(), Tableau2()
Dim Resultat As String

Ligne = Range("B65536").End(xlUp).Row ' derniere ligne non vide colonne A
M = 1
N = 1
ReDim Preserve Tableau(M) 'tableau valeurs uniques colonne A
ReDim Preserve Tableau2(N) ' tableau pour numero de lignes doublons

Application.ScreenUpdating = False
For Each Cell In Range("B4:B" & Ligne)
U = 0
For I = 1 To M
If Cell = Tableau(I - 1) Then '
Tableau2(N - 1) = Cell.Row ' recupere numero de ligne quand un doublon est detecté
N = N + 1
ReDim Preserve Tableau2(N)
U = 1
End If
Next I

If Tableau(M - 1) = "" And U = 0 Then
Tableau(M - 1) = Cell ' remplissage tableau valeurs uniques si pas de doublon détecté
M = M + 1
ReDim Preserve Tableau(M)
End If
Next Cell

For I = N - 1 To 1 Step -1 ' boucle pour supprimer les lignes de doublons
Rows(Tableau2(I - 1)).Delete
Next I
Application.ScreenUpdating = True

End Sub

 

[Robert]

Re : :-( Doublons De M.....

Bonjour Bat, bonjour le forum,

Je te propose cette macro :

Sub Macro1()
Dim Cel As Range 'déclare la variable cel
Dim vad As String 'déclare la variable vad
Dim li As Long 'déclare la variable li
Dim x As Long 'déclare la variable x
 
li = Range("B65536").End(xlUp).Row 'définit la variable li
 
For Each Cel In Range("B1:B" & li) 'boucle 1 sur toutes les cellules éditée de la colonne B
 
    vad = Cel.Address 'définit la variable vad
 
    'boucle 2 sur toutes les cellules éditées de la colonne B de la dernière à la première
    For x = li To 1 Step -1
 
        'condition 2 : si la valeur de la cellule est la même avec une adresse différente
        If Cells(x, 2).Value = Cel.Value And Cells(x, 2).Address <> vad Then
            Cells(x, 2).EntireRow.Delete 'supprime la ligne
        End If 'fin de la condition 2
 
    Next x 'prochaine cellule de la boucle 2
 
Next Cel 'prochaine cellule de la boucle 1
End Sub

Édition :

Bonjour Marie on s'est croisé. Bat je te recommande aussi l'utilisation de tableaux dynamiques proposée par Céléda. Elle plus rapide si tu as de nombreuses lignes.

 

[Hervé]

Re : :-( Doublons De M.....

bises celeda, bonjour bat, salut robert

une autre proposition vba :

Sub Bouton1_QuandClic()
Dim data As New Collection
Dim i As Integer
Dim el
Dim present As Boolean

On Error Resume Next
For i = 1 To Range("b65536").End(xlUp).Row
    data.Add i, CStr(Cells(i, 2))
Next i
On Error GoTo 0

For i = Range("b65536").End(xlUp).Row To 1 Step -1
    present = False
    For Each el In data
        If el = i Then
            present = True
        End If
    Next el
    
    If Not present Then
        Rows(i).Delete
    End If
Next i

End Sub

à mon avis moins pratique que les deux autres car moins "lisible".

salut