XL 2019 Chiffre aligner sans doublon

G

Guismo33

XLDnaute Occasionnel
Bonjour a tous.

je recherche une formule sans doublons et qui aligne un certain nombre de chiffres:
dans cette exemple je voudrais q'en I2:T2 il s'affiche ces nombres : 8 13 7 1 11 14 16
car dans la colonne dite en H j'ai plusieurs nombre avec des vides et doublons.
formules Vba ou simplifier, merci à vous


bien à vous
 

Pièces jointes

  • fonction.JPG
    fonction.JPG
    20.2 KB · Affichages: 19
Trier par date Trier par votes
job75

job75

XLDnaute Barbatruc
Bonjour Guismo33, CISCO,

Une solution VBA pour varier le plaisir :
VB: 
Sub Transpose()
Dim P As Range
Application.ScreenUpdating = False
With ActiveSheet 'à adapter
    Set P = .UsedRange.Columns(1).Cells
    With .[C1] 'cellule de destination à adapter
        .Resize(, .Parent.Columns.Count - .Column + 1).ClearContents 'RAZ
        With .Resize(, P.Count)
            .Value = Application.Transpose(P)
            On Error Resume Next 'si aucune SpecialCell
            .SpecialCells(xlCellTypeBlanks).Delete xlToLeft
        End With
    End With
End With
End Sub
A+
 

Pièces jointes

  • VBA Classeur(1).xlsm
    19.4 KB · Affichages: 5
Vote positif 0 Vote négatif
job75

job75

XLDnaute Barbatruc
La solution précédente peut prendre trop de temps s'il y a beaucoup de cellules vides à supprimer.

Avec ce fichier (2) ce sera toujours très rapide car on utilise des tableaux VBA :
VB: 
Sub Transpose()
Dim a, b(), i&, n%
With ActiveSheet 'à adapter
    a = .UsedRange.Columns(1).Resize(, 2) 'matrice, plus rapide, au moins 2 éléments
    ReDim b(1 To 1, 1 To UBound(a))
    For i = 1 To UBound(a)
        If a(i, 1) <> "" Then
            n = n + 1
            b(1, n) = a(i, 1)
        End If
    Next
    '---restitution---
    With .[C1] 'cellule de destination à adapter
        If n Then .Resize(, n) = b
        .Offset(, n).Resize(, .Parent.Columns.Count - n - .Column + 1).ClearContents 'RAZ à droite
    End With
    With .UsedRange: End With 'actualise la barre de défilement horizontale
End With
End Sub
 

Pièces jointes

  • VBA Classeur(2).xlsm
    19.9 KB · Affichages: 8
Vote positif 0 Vote négatif
G

Guismo33

XLDnaute Occasionnel
CISCO à dit:
Bonjour

Cf. une méthode en pièce jointe, avec une formule matricielle à valider avec Ctrl+maj+entrer.

@ plus
Cliquez pour agrandir...
job75 à dit:
La solution précédente peut prendre trop de temps s'il y a beaucoup de cellules vides à supprimer.

Avec ce fichier (2) ce sera toujours très rapide car on utilise des tableaux VBA :
VB: 
Sub Transpose()
Dim a, b(), i&, n%
With ActiveSheet 'à adapter
    a = .UsedRange.Columns(1).Resize(, 2) 'matrice, plus rapide, au moins 2 éléments
    ReDim b(1 To 1, 1 To UBound(a))
    For i = 1 To UBound(a)
        If a(i, 1) <> "" Then
            n = n + 1
            b(1, n) = a(i, 1)
        End If
    Next
    '---restitution---
    With .[C1] 'cellule de destination à adapter
        If n Then .Resize(, n) = b
        .Offset(, n).Resize(, .Parent.Columns.Count - n - .Column + 1).ClearContents 'RAZ à droite
    End With
    With .UsedRange: End With 'actualise la barre de défilement horizontale
End With
End Sub
Cliquez pour agrandir...
Re
Merci pour cette macro
job75 à dit:
La solution précédente peut prendre trop de temps s'il y a beaucoup de cellules vides à supprimer.

Avec ce fichier (2) ce sera toujours très rapide car on utilise des tableaux VBA :
VB: 
Sub Transpose()
Dim a, b(), i&, n%
With ActiveSheet 'à adapter
    a = .UsedRange.Columns(1).Resize(, 2) 'matrice, plus rapide, au moins 2 éléments
    ReDim b(1 To 1, 1 To UBound(a))
    For i = 1 To UBound(a)
        If a(i, 1) <> "" Then
            n = n + 1
            b(1, n) = a(i, 1)
        End If
    Next
    '---restitution---
    With .[C1] 'cellule de destination à adapter
        If n Then .Resize(, n) = b
        .Offset(, n).Resize(, .Parent.Columns.Count - n - .Column + 1).ClearContents 'RAZ à droite
    End With
    With .UsedRange: End With 'actualise la barre de défilement horizontale
End With
End Sub
Cliquez pour agrandir...
Bonjour,
merci pour cette macro Job75, bonne journée.


bien à vous
 

Pièces jointes

  • Classeur3 (3).xlsx
    11.3 KB · Affichages: 6
Vote positif 0 Vote négatif
job75

job75

XLDnaute Barbatruc
Ah oui les doublons alors voyez ce fichier (3) :
VB: 
Sub TransposeSansDoublon()
Dim a, d As Object, i&
With ActiveSheet 'à adapter
    a = .UsedRange.Columns(1).Resize(, 2) 'matrice, plus rapide, au moins 2 éléments
    Set d = CreateObject("Scripting.Dictionary")
    For i = 1 To UBound(a)
        If a(i, 1) <> "" Then d(a(i, 1)) = ""
    Next
    '---restitution---
    With .[C1] 'cellule de destination à adapter
        If d.Count Then .Resize(, d.Count) = d.keys
        .Offset(, d.Count).Resize(, .Parent.Columns.Count - d.Count - .Column + 1).ClearContents 'RAZ à droite
    End With
    With .UsedRange: End With 'actualise la barre de défilement horizontale
End With
End Sub
 

Pièces jointes

  • VBA Classeur(3).xlsm
    20.6 KB · Affichages: 3
Vote positif 0 Vote négatif
CISCO

CISCO

XLDnaute Barbatruc
Bonsoir à tous, bonsoir Job75, bonsoir Guismo33

J'avais complètement oublié de traiter le cas des doublons (des triplets, quadruplets...). C'est fait dans le fichier ci-dessous, toujours avec une formule matricielle.

@ plus
 

Pièces jointes

  • Classeur3 (3).xlsx
    10.6 KB · Affichages: 10
Vote positif 0 Vote négatif
job75

job75

XLDnaute Barbatruc
BonjourGuismo33, CISCO, le forum,

@CISCO ta formule a l'avantage de pouvoir être utilisée sur les versions antéreures à Excel 2007.

Mais Guismo33 étant sur Excel 2019 on peut utiliser SIERREUR, formule matricielle en C5 :
Code: 
=SIERREUR(INDEX($A$1:$A$11;PETITE.VALEUR(SI(($A1:$A11<>"")*NON(NB.SI($B5:B5;$A$1:$A$11));LIGNE($A$1:$A$11));1));"")
Bonne journée.
 

Pièces jointes

  • Classeur3 (4).xlsx
    11 KB · Affichages: 9
Vote positif 0 Vote négatif
patricktoulon

patricktoulon

XLDnaute Barbatruc
bonsoir
sinon avec vba
sans doublons dans l'ordre sans dico ou collection
VB: 
Sub test()    'horizontal
    Dim rng As Range, tableau
    Set rng = Range("A1:A11")
    tableau = NoDoubleInOrder(rng)
    [c6].Resize(, UBound(tableau) + 1) = tableau
End Sub
'
Sub test2()    'vertical
    Dim rng As Range, tableau
    Set rng = Range("A1:A11")
    tableau = NoDoubleInOrder(rng)
    [c6].Resize(UBound(tableau) + 1, 1) = Application.Transpose(tableau)
End Sub    '
'
'
Function NoDoubleInOrder(rng)
    Dim original, MyArray(), I&
    original = Application.Transpose(rng.Value)
    ReDim MyArray(1 To Application.Max(rng))
    For I = 1 To UBound(original)
        If original(I) <> "" Then MyArray(Val(original(I))) = original(I)
    Next
    NoDoubleInOrder = Split(Application.Trim(Join(MyArray)), " ")
End Function
 
Vote positif 0 Vote négatif
G

Guismo33

XLDnaute Occasionnel
job75 à dit:
BonjourGuismo33, CISCO, le forum,

@CISCO ta formule a l'avantage de pouvoir être utilisée sur les versions antéreures à Excel 2007.

Mais Guismo33 étant sur Excel 2019 on peut utiliser SIERREUR, formule matricielle en C5 :
Code: 
=SIERREUR(INDEX($A$1:$A$11;PETITE.VALEUR(SI(($A1:$A11<>"")*NON(NB.SI($B5:B5;$A$1:$A$11));LIGNE($A$1:$A$11));1));"")
Bonne journée.
Cliquez pour agrandir...
Bonjour job75,

merci pour cette formule ,elle me conviens bonne journée.
 
Vote positif 0 Vote négatif

Discussions similaires

P
  • Question
XL 2013 Comment fusionner plusieurs listes de nombres en un seul classement général
Réponses
4
Affichages
495
pelletim
P
B
  • Question
XL 2021 Insertions de plus de 10 textbox et combobox dans listbox
Réponses
9
Affichages
548
cp4
cp4
X
  • Question
XL 2019 Script pour vérifier le nombre doublon par rapport à un filtre
Réponses
9
Affichages
583
xorf
X
P
  • Résolu(e)
Microsoft 365 Erreur d'exécution "9" :L'indice n'appartient pas à la sélection
Réponses
9
Affichages
965
pelerin65
P
T
  • Question
XL 2016 Optimisation d'une boucle
2 3
Réponses
30
Affichages
932
thivame
T
I
  • Résolu(e)
XL 2019 Supprimer une ligne d'une base de données une fois qu'elle est transférée sur une autre feuille
Réponses
8
Affichages
403
Isabellisa
I
L
  • Question
XL 2016 Macro et suppressions de lignes
Réponses
9
Affichages
609
fanfan38
fanfan38
S
  • Résolu(e)
Autres ActiveWorkbook.Worksheets("vierge").AutoFilter.Sort.SortFields.Clear
2
Réponses
23
Affichages
1 K
AtTheOne
AtTheOne
2
  • Résolu(e)
Microsoft 365 Code VBA avec plusieurs conditions SI
Réponses
6
Affichages
355
D.D.
D
T
  • Résolu(e)
Microsoft 365 Conditionner l'accès à une page d'un multipage
2
Réponses
26
Affichages
2 K
TooFatBoy
TooFatBoy

Membres actuellement en ligne

Aucun membre en ligne actuellement.
1 membres et 42 invités.

Partager cette page

Tutos vidéos

Power Query : Ajouter des requêtes (Excel et Power BI)
Créez votre première fonction LAMBDA dans Excel en 3 étapes!
LAMBDA, l’arme secrète de Microsoft pour Excel !
Office Insider - Découvrez les nouveautés Excel avant tout le monde

Statistiques des forums

Discussions
312 215
Messages
2 086 329
Membres
103 184
dernier inscrit
Di Martino