Suppression des doublons sous condition

[sevy1]

Bonjour le forum
J'ai un fichier les doublons se trouvent sur la colonne A et je ne veux conserver que la ligne donc la colonne C contient une valeur
NB: seule une ligne contient une valeur au niveau de la colonne C pour les valeurs identiques à la colonne A
Voici un exemple de code masi qui me conserve uniquement la première ligne.

Sub SupDoublonsColA()
  Application.ScreenUpdating = False
  Set f1 = Sheets("BASE")
  a = f1.Range("A1").CurrentRegion.Value
  Dim c()
  ReDim c(1 To UBound(a, 1), 1 To UBound(a, 2))
  ligne = 1
  Set mondico = CreateObject("Scripting.Dictionary")
  For i = 1 To UBound(a)
    If Not mondico.exists(a(i, 1)) Then
      mondico.Add a(i, 1), 1
      For k = 1 To UBound(a, 2): c(ligne, k) = a(i, k): Next k
      ligne = ligne + 1
    End If
  Next
  Sheets("RE").[A1].Resize(mondico.Count, UBound(a, 2)) = c
End Sub

Merci d'avance pour votre aide

 

[sevy1]

Re : Suppression des doublons sous condition

Bonjour
J'ai oublié de joindre un classeur exemple

 

[Paf]

Re : Suppression des doublons sous condition

Bonjour,


si j'ai tout compris, on peut se limiter à ne prendre que les lignes pour lesquelles la colonne C est renseignée ( ?)
un classeur exemple aurait été souhaité (voire charte) pour tester:

Sub SupDoublonsColA()
  Application.ScreenUpdating = False
  Set f1 = Sheets("BASE")
  a = f1.Range("A1").CurrentRegion.Value
  Dim c()
  ligne = 1
  For i = 1 To UBound(a)
    If a(i, 3) <> "" Then
    ReDim Preserve c(1 To UBound(a, 2), 1 To ligne)
      For k = 1 To UBound(a, 2): c(k, ligne) = a(i, k): Next k
      ligne = ligne + 1
    End If
  Next
  Sheets("RE").[A1].Resize(UBound(c, 2), UBound(c, 1)) = Application.Transpose(c)
End Sub

A+

Edit : Je n'ai rien dit au sujet du classeur absent !!

 

[sevy1]

Re : Suppression des doublons sous condition

Bonjour
Merci ça fonctionne mon seul souci est que la mise en forme n'est pas conservée car dans mon tableau avec doublon la colonne A est la chaine de caractère (TEXTE) alors que dans le tableau sans doublon c'est du numérique. Alors comment faire?

 

[Paf]

Re : Suppression des doublons sous condition

Re,

Pas trouvé d'autre solution que cette ligne à rajouter en fin de code

 Sheets("RE").[A1].Resize(UBound(c, 2), 1).NumberFormat = "@"

Bonne suite