XL 2016 Suppression Doublons et Tri par Colonnes

  • Initiateur de la discussion Initiateur de la discussion FAB80170
  • Date de début Date de début

Boostez vos compétences Excel avec notre communauté !

Rejoignez Excel Downloads, le rendez-vous des passionnés où l'entraide fait la force. Apprenez, échangez, progressez – et tout ça gratuitement ! 👉 Inscrivez-vous maintenant !

FAB80170

XLDnaute Junior
Bonjour,

Je souhaite supprimer les doublons et trier par ordre croissant chaque colonnes individuellement sur une feuille unique.

Ma base contient plus de 30 000 lignes et plus de 30 colonnes et mon classeur plus de 20 onglets.

J'ai fourni un petit fichier pour exemple, avec des données et le résultat escompté (merci de tenir compte de l'execution sur une feuille unique).

Par avance merci.
 

Pièces jointes

Bonjour Fab80170,

Un essai avec ce code ;-)
Code:
Sub SupDoublonsEtTri()
  Dim Col As Long, ColTmp As Long, NbCol As Long, NbLig As Long
  ' Dernière colonne
  NbCol = Cells(1, Columns.Count).End(xlToLeft).Column
  ' Numéro de la colonne temporaire
  ColTmp = NbCol + 1
  ' Pour chaque colonne
  For Col = 1 To NbCol
    ' Dernière ligne de la colonne
    NbLig = Cells(Rows.Count, Col).End(xlUp).Row
    ' Filtrer sans doublon
    Range(Cells(1, Col), Cells(NbLig, Col)).AdvancedFilter Action:=xlFilterInPlace, Unique:=True
    ' Copier les données dans la colonne temporaire
    Range(Cells(1, Col), Cells(NbLig, Col)).Copy Destination:=Cells(1, ColTmp)
    ' Supprimer le filtre
    On Error Resume Next
    ActiveSheet.ShowAllData
    On Error GoTo 0
    ' Effacer le contenu de la colonne
    Range(Cells(1, Col), Cells(NbLig, Col)).ClearContents
    ' Coller le résultat de la colonne temporaire
    Columns(ColTmp).Copy Destination:=Columns(Col)
    ' Effacer le contenu de la colonne temporaire
    Columns(ColTmp).ClearContents
    ' Trier le résultat
    With ActiveSheet.Sort
      .SortFields.Clear
      .SortFields.Add Key:=Columns(Col), _
        SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
      .SetRange Columns(Col)
      .Header = xlYes
      .MatchCase = False
      .Orientation = xlTopToBottom
      .SortMethod = xlPinYin
      .Apply
    End With
  ' Colonne suivante
  Next Col
End Sub

A+
 
Bonjour, FAB80170, BrunoM45 🙂, le Forum,

Une autre suggestion :
VB:
Option Explicit
Sub Doublons_supprimer_colonnes_trier()
    Dim c As Range
    With Application: .ScreenUpdating = False: .Calculation = xlManual: .EnableEvents = False: End With
    For Each c In Rows("1:1").SpecialCells(xlCellTypeConstants, 23)
        c.Select
        With Selection.EntireColumn
            .RemoveDuplicates Columns:=1, Header:=xlYes
            .Sort [Selection], Header:=xlYes
        End With
    Next
    Application.Goto Range("a1"), True
    With Application: .EnableEvents = True: .Calculation = xlAutomatic: .ScreenUpdating = True: End With
End Sub
A bientôt 🙂
 
Bonsoir à tous

la même que 00, les select en moins 😉
VB:
Sub Doublons_supprimer_colonnes_trierNOSELECT()
Dim i&
With Application: .ScreenUpdating = False: .Calculation = xlManual: .EnableEvents = False: End With
For i = 1 To ActiveSheet.UsedRange.Columns.Count
    With Columns(i).EntireColumn
        .RemoveDuplicates Columns:=1, Header:=xlYes: .Sort .Range("A1"), Header:=xlYes
End With
Next
With Application: .EnableEvents = True: .Calculation = xlAutomatic: .ScreenUpdating = True: End With
End Sub
 
Salut

Pour éviter une indigestion d’endives à la mode de Staple 😛 dans le plat de ÓÒ 😀
VB:
Sub SansDoublonsTri()
    Dim C As Range
    With Application: .ScreenUpdating = 0: .Calculation = xlManual: .EnableEvents = 0
     For Each C In ActiveSheet.UsedRange.Columns
       C.Columns.RemoveDuplicates 1, 1: C.Columns.Sort Cells(1, C.Column), Header:=1
     Next
    .EnableEvents = 1: .Calculation = xlAutomatic: .ScreenUpdating = 1: End With
End Sub
 
- Navigue sans publicité
- Accède à Cléa, notre assistante IA experte Excel... et pas que...
- Profite de fonctionnalités exclusives
Ton soutien permet à Excel Downloads de rester 100% gratuit et de continuer à rassembler les passionnés d'Excel.
Je deviens Supporter XLD

Discussions similaires

  • Question Question
XL 2021 Doublons
Réponses
7
Affichages
138
  • Question Question
XL 2021 listbox
Réponses
18
Affichages
294
  • Question Question
Microsoft 365 tri dans Excell
Réponses
19
Affichages
620
Retour