Microsoft 365 Comment supprimer les doublons et plus

brabra74

XLDnaute Nouveau
Bonjour a tous, je sais comment supprimer les doublons, mais je veux aussi mettre la référence dans la case suivante dans la référence principale. je met un fichier excel pour clarifier la chose, merci a tous
 

Pièces jointes

  • test doublons.xlsx
    16.9 KB · Affichages: 7

patricktoulon

XLDnaute Barbatruc
Bonjour
et oui mais tout le monde n'a pas UNIQUE et FILTER

je propose une fonction perso "UNIQUEx" qui réunira UNIQUE et FILTER
cette fonction filtre bien entendu les doublons sur un tableau de deux colonnes par la colonne 1 ou 2

VB:
Option Explicit
Function UNIQUEx(RNG As Range, col)
    Dim T, dic As Object, I&, t2, K, It, kx, itX, Col2: T = RNG.Value
    Set dic = CreateObject("Scripting.Dictionary")
    If col = 1 Then Col2 = 2 Else Col2 = 1
    For I = 1 To UBound(T): dic(T(I, col)) = T(I, Col2): Next: K = dic.keys: It = dic.items: kx = K: itX = It
    If col = 2 Then kx = It: itX = K
    ReDim t2(1 To Application.Caller.Rows.Count, 1 To 2)
    For I = 1 To UBound(t2)
        If I <= UBound(kx) + 1 Then t2(I, 1) = kx(I - 1): t2(I, 2) = itX(I - 1) Else t2(I, 1) = "": t2(I, 2) = ""
    Next
    UNIQUEx = t2
End Function

cette fonction fonctionne en Matricielle
sélectionner une plage de même taille et mettre la formule et valider en matriciel pour les versions inférieures a 365
demo
demo2.gif


1644403062814.png

Lol
Ok je sort😁
 

Pièces jointes

  • Fonction UNIQUEx doublons + clé .xlsm
    19.6 KB · Affichages: 1
Dernière édition:

mapomme

XLDnaute Barbatruc
Supporter XLD
Re,

Une version sans dictionary (qui doit donc fonctionner sur Apple - mais avec un tri).

Le code est dans module de la feuille "Feuil1". ou bien en cliquant sur le bouton Hop!
Le tableau résultat se met à jour quand on modifie une des cellules des colonnes A:B
La première fois, si aucun changement, éditer une cellule dans la plage A:B et la re-valider par Entrée (ou cliquer sur le bouton Hop!)
 

Pièces jointes

  • brabra74 - En ligne- v1.xlsm
    21.5 KB · Affichages: 5
Dernière édition:

mapomme

XLDnaute Barbatruc
Supporter XLD
Bonjour @patricktoulon :),
je suppose que tu utilise un object collection ??
même pas :oops:

On copie la source en colonne E
On trie les colonnes E:F selon la colonne E
On transfère les colonnes E:F dans l'array t
ensuite on boucle sur l'array t (rappel : la 1ère colonne de t est triée)
____ s'il y a un changement de valeur entre i et i-1
____ on incrémente ligne qui est la ligne où écrire dans t
____ le numéro de colonne k est égal à 2
____ on inscrit dans t(ligne, k) la valeur t(i, 2)
sinon
____ on garde la même ligne d'écriture ligne
____ on incrémente le numéro de colonne où inscrire : k= k+ 1
____ si le n° de colonne k est sup. au nbr de colonnes de t, on redimensionne t à nbr+1 col.
____ on inscrit dans t(ligne, k) la valeur t(i, 2)
endif
Fin boucle sur t

A la fin, le tableau résultat à partir de la colonne est tassé sur les "Ligne" premières lignes de t
On inscrit le tableau t à partir de E1 (nbr lignes = ligne ; nbr colonnes = nbr colonnes de t)
On corrige la première colonne
on inscrit dans la colonne E la première colonne de t
on ôte les doublons de la colonne E (removeDuplicates)
On formate

Pour 185.000 lignes, la durée est d'environ 2,5 sec.
 

Pièces jointes

  • brabra74 - En ligne- v1a.xlsm
    20.7 KB · Affichages: 6
Dernière édition:

mapomme

XLDnaute Barbatruc
Supporter XLD
un match à l'ancienne quoi ,sur un tableau trier dans l'ordre
est ce plus rapide que l'object collection ( valable me semble t il dans Mac )?
Les commentaires ne sont pas pour toi bien sûr. Ca m'étonnait que tu poses la question.

Oui, une seule fois dans une de mes solutions, le traitement sur un tableau trié était plus rapide que le dictionary. Je ne la retrouve plus et c'était une seule fois ;).
En tout cas, un tableau trié est toujours très rapide (mais ça modifie l'ordre du résultat).

Le problème de la collection, c'est que ce n'est pas pratique à utiliser, en particulier les modifications d'item déjà existants (suppression puis rajout et donc on perd aussi l'ordre de lecture de la source)
 
Dernière édition:

patricktoulon

XLDnaute Barbatruc
re
il me viens une idée je sais pas tu va me dire
tu redim preserve au fur et à mesure le count rox et colonne dynamiquement
ne pourrait ton pas rredim preserve des le depart le rows.count et le max de colonne
compter les c au fur et a mesure et redimer en dernier les colonne avec c
histoire de gagner encore un peu de temps
je sais pas c'est une idée
 

job75

XLDnaute Barbatruc
Bonjour brabra74, mapomme, Phil69970, patricktoulon,

Une solution par formules, très simples :

- en E1 :
Code:
=SI(LIGNE()=1;A1;SI(DECALER(A1;-1;)=A1;"";A1))
- en F1 =SI(E1="";"";B1)

- en G1 =SI(E1="";B1;"")

Bien sûr le tableau source doit être trié sur la colonne A.

C'est certainement très rapide sur un grand tableau.

A+
 

Pièces jointes

  • test doublons(1).xlsx
    17.5 KB · Affichages: 2
Dernière édition:

job75

XLDnaute Barbatruc
En VBA on entrera simplement les formules :
VB:
Sub Doublons()
With [A1].CurrentRegion
    .Sort .Cells(1), xlAscending, Header:=xlNo
    With [E1].Resize(.Rows.Count, 2)
        .Columns(1) = "=IF(ROW()=1,A1,IF(OFFSET(A1,-1;)=A1,"""",A1))"
        .Columns(2) = "=IF(E1="""","""",B1)"
        .Columns(3) = "=IF(E1="""",B1,"""")"
        .Value = .Value 'supprime les formules
        .Borders.Weight = xlThin 'bordures
        .Offset(.Rows.Count).Resize(Rows.Count - .Rows.Count).Delete xlUp 'RAZ en dessous
    End With
End With
End Sub
 

Pièces jointes

  • Doublons VBA(1).xlsm
    24.8 KB · Affichages: 2

laurent950

XLDnaute Accro
Bonjour le forum,

Avec une variable collection et une variable tableau

VB:
Option Explicit
'
Sub test()
Dim Coll As New Collection
Dim c As Variant
Dim tbl() As Variant
Dim i As Long
' Test Doublon.
For i = 1 To [A1].CurrentRegion.Rows.Count ' adapter
    On Error Resume Next
        Coll.Add Item:=Array(Cells(i, 1).Value2, Cells(i, 2).Value2), Key:=CStr(Cells(i, 1))
        If Err.Number <> 0 Then
            tbl = Coll.Item(CStr(Cells(i, 1)))
            ReDim Preserve tbl(LBound(tbl) To UBound(tbl) + 1)
            tbl(UBound(tbl)) = Cells(i, 2)
            Coll.Remove CStr(Cells(i, 1))
            Coll.Add tbl, CStr(Cells(i, 1))
        End If
Next i
' Restitution
    For Each c In Coll
        Cells(Cells(65535, 5).End(xlUp).Row + 1, 5).Resize(LBound(c) + 1, UBound(c) + 1) = c
    Next c
End Sub
 
Dernière édition:

Discussions similaires

Réponses
10
Affichages
421

Statistiques des forums

Discussions
312 225
Messages
2 086 412
Membres
103 202
dernier inscrit
Claire2BM