Microsoft 365 rechercher doublons horizontalement

[brabra74]

Bonjour, je cherche une formule pour rechercher des doublons sur des cellules mais horizontalement.

merci

 

[eddy1975]

Bonsoir,
Sans fichier et sans exemple, difficile de se projeter.
Cependant une MFC serait surement une solution.
@+

 

[brabra74]

voici le fichier d'exemple

 

[job75]

Bonsoir brabra74, eddy1975,

Formule matricielle en J1 :

=SIERREUR(INDEX($B1:F1;PETITE.VALEUR(SI(NON(NB.SI($I1:I1;$B1:$F1));COLONNE($B1:$F1)-1);1));"")

Elle fonctionne même si les valeurs sont des textes.

A+

 

[brabra74]

Bonsoir brabra74, eddy1975,

Formule matricielle en J1 :

=SIERREUR(INDEX($B1:F1;PETITE.VALEUR(SI(NON(NB.SI($I1:I1;$B1:$F1));COLONNE($B1:$F1)-1);1));"")

Elle fonctionne même si les valeurs sont des textes.

A+

merci beaucoup, formule très efficace, que j'ai appliqué sur 180000 lignes. encore merci

 

[mapomme]

Bonjour,

En 365, on peut utiliser la formule:
=TRANSPOSE(UNIQUE(TRANSPOSE(B1:F1)))

edit : bonjour @LAETI-TOINOU

 

[job75]

Bonjour brabra74, eddy1975, mapomme,

merci beaucoup, formule très efficace, que j'ai appliqué sur 180000 lignes. encore merci

La copie de lq ligne 1 sur 180 000 lignes se fait chez moi en 50 secondes :

Sub Copier()
Dim t
t = Timer
Rows(1).AutoFill Rows(1).Resize(180000), xlFillValues
MsgBox Timer - t
End Sub

Le VBA permettra peut-être d'aller plus vite, je n'ai pas essayé

A+

 

[mapomme]

Bonjour @job75

Le VBA permettra peut-être d'aller plus vite

J'ai essayé. Sauf erreur de ma part, c'est beaucoup plus rapide.

 

[job75]

Voici une macro avec le Dictionary :

Sub Doublons()
Dim ncol%, R As Range, t, tablo, ub%, resu(), d As Object, i&, n%, j%, x
ncol = 5 'nombre maximum de colonnes des résultats, à adapter
Set R = [B1:F180000] 'à adapter
'---initialisation---
R = "=RANDBETWEEN(1," & ncol & ")" 'ALEA.ENTRE.BORNES
R = R.Value 'supprime les formules
'---traitement des doublons---
t = Timer
tablo = R 'matrice, plus rapide
ub = UBound(tablo, 2)
ReDim resu(1 To UBound(tablo), 1 To ncol)
Set d = CreateObject("Scripting.Dictionary")
For i = 1 To UBound(tablo)
    d.RemoveAll 'RAZ
    n = 0
    For j = 1 To ub
        x = tablo(i, j)
        If Not d.exists(x) Then d(x) = "": n = n + 1: resu(i, n) = x
Next j, i
'---restitution---
With [I1] '1ère cellule de restitution, à adapter
    .Resize(i - 1, ncol) = resu
    .Offset(i - 1).Resize(Rows.Count - i - .Row + 2, ncol).ClearContents 'RAZ en dessous
End With
MsgBox Format(i - 1, "#,##0") & " lignes traitées en " & Format(Timer - t, "0.0 \sec"), , "Doublons"
End Sub

Chez moi elle s'exécute en 2;3 secondes contre 1,7 seconde pour celle de mapomme.