Doublon (effacer une ligne sur deux).

[BRUNO62]

Bonjour,

En pièce jointe ma demande.
Par avance merci.
a+

 

[ROGER2327]

Re : Doublon (effacer une ligne sur deux).

Bonjour BRUNO62

Peut-être ceci :

[COLOR="DarkSlateGray"][B]Sub toto()
Dim tablo, i&
   tablo = Range("A2:A" & Range("A65536").End(xlUp).Row)
   For i = UBound(tablo, 1) To 2 Step -1
      If tablo(i, 1) = tablo(i - 1, 1) Then tablo(i, 1) = ""
   Next i
   Range("B2").Resize(UBound(tablo, 1), 1) = tablo
End Sub[/B][/COLOR]

ROGER2327
#3447

19 Floréal An CCXVIII
2010-W18-6T12:17:02Z

 

[JCGL]

Re : Doublon (effacer une ligne sur deux).

Bonjour à tous,

Par formule en B2 et suivantes :

=SI(A1=A2;"";A2)

A+ à tous

 

[job75]

Re : Doublon (effacer une ligne sur deux).

Bonjour BRUNO62, salut Roger, JC,

J'ai vu votre macro Bruno, et j'ai l'impression que vous voulez quelque chose comme ceci :

Sub Remplir()
Dim data As Object, tablo, i As Long
Set data = CreateObject("Scripting.Dictionary")
Range("B2:B65536").ClearContents
tablo = Range("A1:B" & Range("A65536").End(xlUp).Row)
For i = 2 To UBound(tablo)
  If Not data.Exists(tablo(i, 1)) Then
    data.Add tablo(i, 1), CStr(tablo(i, 1))
    tablo(i, 2) = tablo(i, 1)
  End If
Next
Range("A1:B" & UBound(tablo)) = tablo
End Sub

Donc seule la 1ère occurence d'une valeur en colonne A est prise en compte.

A+

 

[job75]

Re : Doublon (effacer une ligne sur deux).

Re,

Une solution un peu différente, mais le principe reste le même :

Sub Remplir()
Dim data As Object, tablo, i As Long
Set data = CreateObject("Scripting.Dictionary")
tablo = Application.Transpose(Range("A2:A" & Range("A65536").End(xlUp).Row))
For i = 1 To UBound(tablo)
  If data.Exists(tablo(i)) Then
    tablo(i) = ""
  Else
    data.Add tablo(i), CStr(tablo(i))
  End If
Next
Range("B2:B65536").ClearContents
Range("B2").Resize(UBound(tablo)) = Application.Transpose(tablo)
End Sub

Il serait intéressant de savoir laquelle des 2 solutions est la plus rapide (sur un très grand tableau bien sûr).

A+