Supprimer doublons et trier

Bonjour le forum

Je cherche à supprimer les doublons dans les lignes et à trier ces lignes part ordre croissant.

Quelle formule ou macro faudrait-il utiliser.

Merci

Bonjour

en fait il y a 2 questions confuses

1) supprimer les doublons

exemple en ligne 2 il y a la valeur 7 en C2 et en W2 c'est un doublon mais on fait quoi dans ce cas

mettre la cellule C2 vide ou mettre la cellule W2 vide ou faut il décaler les valeurs vers la gauche?

2) trier les ligne

oui mais suivant quel critère ?

A plus sur le forum

Bonjour papyg

Merci de me répondre.

Pour les doublons je n'en garde qu'un et pour le tri c'est par ordre croissant.

Excel le fait mais mais il faut que les données soit verticales et une colonne a la fois et j'ai plusieurs centaines de lignes.

Merci

Salut le forum,

un essai et adapter

Option Explicit

Sub SupprDoublonsTrier()
  Dim A As Range, Where As Range
  Dim sh As Worksheet, Data

Set sh = ActiveWorkbook.Worksheets("Feuil1")
    sh.Sort.SortFields.Clear
    sh.Sort.SortFields.Add Key:=Range("A2:AO2") _
        , SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    With sh.Sort
        .SetRange Range("B2", Range("AO" & Rows.Count).End(xlUp))
        .Header = xlGuess
        .MatchCase = False
        .Orientation = xlLeftToRight
        .SortMethod = xlPinYin
        .Apply
    End With

  For Each A In Range("B2", Range("B" & Rows.Count).End(xlUp))
    Set Where = Intersect(A.EntireRow, Range("B:AO"))
    Data = UniqueItems(Where, vbTextCompare)
    Where.ClearContents
    Where(1).Resize(, UBound(Data) + 1).Value = Data
  Next
End Sub

Private Function UniqueItems(ByVal r As Range, _
    Optional ByVal Compare As VbCompareMethod = vbBinaryCompare, _
    Optional ByRef Count) As Variant
  'Return an array with all unique values in R
  '  and the number of occurrences in Count
  Dim Area As Range, Data
  Dim i As Long, j As Long
  Dim Dict As Object 'Scripting.Dictionary
  Set r = Intersect(r.Parent.UsedRange, r)
  If r Is Nothing Then
    UniqueItems = Array()
    Exit Function
  End If
  Set Dict = CreateObject("Scripting.Dictionary")
  Dict.CompareMode = Compare
  For Each Area In r.Areas
    Data = Area
    If IsArray(Data) Then
      For i = 1 To UBound(Data)
        For j = 1 To UBound(Data, 2)
          If Not Dict.Exists(Data(i, j)) Then
            Dict.Add Data(i, j), 1
          Else
            Dict(Data(i, j)) = Dict(Data(i, j)) + 1
          End If
        Next
      Next
    Else
      If Not Dict.Exists(Data) Then
        Dict.Add Data, 1
      Else
        Dict(Data) = Dict(Data) + 1
      End If
    End If
  Next
  UniqueItems = Dict.Keys
  Count = Dict.Items
End Function

@++

Bonjourm3ellem1

Merci pour ta réponse, mais il semble ne pas fonctionner je remet le fichier avec le résultat de la macro.

Salut jad,

je ne vois pas pourquoi ca fonctionne pas chez toi!

Voici le fichier avec la macro:

Bonne nuit

Bonjour m3ellem1, le forum

Les doublons sont bien supprimer mais le tri en ordre croissant ne ce fait pas, seule la premiere ligne est bien trier.

Merci

Salut jad,

sorry j'avais mal compris, je pensais il fallait trier les données suivant la première ligne.

À tester

Bonne nuit

Bonjour m3ellem1, le forum

C'est certainement moi qui est dù mal m'exprimé au début.

Par contre j'ai un message d'erreur"Erreur de compilation: Valeur non définie"

et c'est "UsedRange. Select" qui est en bleu.

Dans le fichier mis en retour ce fonctionne bien. Cela pourrait-il venir que dans mon fichier d'origine la BdD et la macro se trouve en Feuil3.

Merci

bonjour

un essai

cordialement