Autres Je cherche à extraire des cellules en ordre croissant et sans doublons Les colonnes de référence ne peuvent être triées.

[Michou9]

Bonjour à tous

Je cherche à extraire des cellules en ordre croissant et sans doublons
Les colonnes de référence ne peuvent être triées.

Il y a des doublons
des cellules texte
des cellules vides
des cellules ""

J’ai mis un exemple ci-joint
La 1ère feuille montre les doublons et les erreurs
La 2ème feuille représente comment je suis arrivé à traité le problème
Je me dis qu’il doit certainement y avoir un moyen de faire beaucoup plus simple
D’autant que en compliquant les circonstances on peut encore trouver des doublons et des erreurs
De plus si on augmente les colonnes .........

J’attends des subjections de personnes plus expérimentées que moi
(Je suis sous Excel 2007)

 

[mapomme]

Bonjour @Michou9🙂,

Comme votre classeur est un classeur .xlsm qui accepte les macros, j'ai pondu une fonction en VBA :
LigneRang ( xrgLigne , Rang ) où :

• xrgLigne est la plage (en ligne) des valeurs
• Rang est l'index du nombre à retourner (sans les textes, sans les vides, sans les doublons) : 1 retourne le plus petit nombre, 2 retourne le 2ème plus petit nombre, etc
• on renvoie une chaine vide si aucune valeur ne correspond au Rang désiré

Dans le classeur joint sur la feuille Feuil2, mettre la formule suivante en =LigneRang($A3:$D3;F$2) en F3. Puis recopier cette formule vers la droite et vers le bas.

Le code de la fonction est dans Module1.

 

[nullosse]

Salut,
voici un autre code en VBA qui lui exécute l'ensemble de ce qui est demandé en une seule fois (donc sans formule) , en prenant en compte une plage de départ (plage nommée Data) et qui met le résultat à partir d'une cellule de résultat ( StartRes ). Ceci n'est intéressant qui si les données de départ ne changent pas souvent et si il n'y a pas trop de lignes à traiter :

Sub NettoyerTrierPlageParLigne()
    Dim plageSource As Range, cellDepart As Range
    Dim data As Variant, newData() As Variant
    Dim i As Long, j As Long, n As Long, k As Long
    Dim nums As Object
    Dim arr As Variant, tri() As Variant
    Dim nbRows As Long, nbCols As Long
    ' --- 1) Définir la plage source ---
    Set plageSource = Range("Data")
    data = plageSource.Value
    nbRows = UBound(data, 1)
    nbCols = UBound(data, 2)
    ReDim newData(1 To nbRows, 1 To nbCols)
    Set nums = CreateObject("Scripting.Dictionary")
    ' --- 2) Nettoyage ligne par ligne ---
    For i = 1 To nbRows
        nums.RemoveAll
        ' Extraire les nombres uniques
        For j = 1 To nbCols
            If IsNumeric(data(i, j)) And data(i, j) <> "" Then
                nums(data(i, j)) = data(i, j)
            End If
        Next j
        ' Convertir en tableau
        arr = nums.Items
        n = nums.Count
        ' Trier avec Application.Small
        If n > 0 Then
            ReDim tri(0 To n - 1)
            For k = 1 To n
                tri(k - 1) = Application.Small(arr, k)
            Next k
        Else
            ReDim tri(0 To 0)
        End If      
        ' Réécrire la ligne : nombres triés puis vides
        k = 0
        For j = 1 To nbCols
            If k <= UBound(tri) Then
                newData(i, j) = tri(k)
                k = k + 1
            Else
                newData(i, j) = ""
            End If
        Next j
    Next i
    ' --- 3) Définir la cellule de départ ---
    Set cellDepart = Range("StartRes")
    ' --- 4) Écriture du résultat ---
    cellDepart.Resize(nbRows, nbCols).Value = newData
End Sub

On peut exécuter la macro si une donnée de la plage change ou est réécrite en mettant ceci dans le code de la feuille de données :

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim plage As Range
    Set plage = Me.Range("Data")
    If Not Application.Intersect(Target, plage) Is Nothing Then
        Application.EnableEvents = False
        Call NettoyerTrierPlageParLigne
        Application.EnableEvents = True
    End If
End Sub

Pour 1000 lignes et 4 colonnes l'exécution de la macro dure 35 ms chez moi.
Voici ce que cela donne dans un Excel 2007 :

Nullosse

 

[Michou9]

Bonjour Mapomme
Je m'attendais à trouver quelque chose de plus simple
Mais alors là, je reste bouche bée !!
Super
Un grand merci

 

[Michou9]

Bonjour Nullosse
Je viens de tester le code
C'est parfait
Différent de Mapomme
Autre méthode
Le résultat est parfait
Un grand merci aussi