Suppression de doublons dans un tableau 1D

[taratata]

bonjour,

j'ai parcouru diverses sources sur le net sur la suppression des doublons dans un tableau (array 1D).
La plus part, s'appuie sur un Range de la feuille pour enfin enregistrer le résultat dans un tableau.
De plus, il faut que la feuille cible soit active.

sub coincoin()
...
Dim Tableau() As Variant
Dim c As Variant
Set MonDico = CreateObject("Scripting.Dictionary")

    Dim Feuille As Worksheet
    Set Feuille = Sheets("DIY_BNIC")
    Feuille.Activate
    
      For Each c In Range([E6], [E65536].End(xlUp))
        'si la donnée n'existe pas encore dans le dictionnaire
         If Not MonDico.Exists(c.Value) Then
            'on l'ajoute dans le dictionnaire...
            MonDico.Add c.Value, c.Value
            '...et dans le tableau VBA ;-)
            ReDim Tableau(1 To MonDico.Count)
            Tableau(MonDico.Count) = c.Value
            Debug.Print MonDico.Count, Tableau(MonDico.Count)
          End If
      Next c
    
    ...
end sub

ce qui me dérange c'est cette écriture

For Each c In Range([E6], [E65536].End(xlUp))

comment fait t-on pour passer de variables à la place de [E6], [E65536]

si on utilise pour un Tableau Structuré

Last_Ligne_Tab_BNIC = (List_obj_DIY_BNIC.Range.Rows.Count)

exemple ([E2], ["E" & Last_Ligne_Tab_BNIC].End(xlUp)) ce qui ne fonctionne pas.

-----------------------------------

Ce que je cherche, c'est de passer la moulinette directement sur le tableau 1D.
je ne suis pas claire avec ceci URL

j'ai besoin d'aide ne français, svp

merci

 

[Dranreb]

Bonjour.
Très nébuleux tout ça …
Qu'est-ce que vous avez au départ et qu'est-ce que vous voulez au final ?

 

[Hasco]

Bonjour,

A tout hasard, d'après ce que je comprends:

Sub coincoin()
    Dim Tableau As Variant ' Tableau des valeurs de la plage de cellules
    Dim c As Variant
    Dim MonDico As Object
    Set MonDico = CreateObject("Scripting.Dictionary")
    With Sheets("DIY_BNIC").Range([E6], [E65536].End(xlUp))
        Tableau = .Value 'Récupérer les valeurs
        ' Le dictionnaire ne retiendra que les valeurs uniques.
        For Each c In Tableau
            MonDico(c) = c
        Next c
        .ClearContents ' Nettoyer l'ancien contenu des cellules
        ' Et y mettre les valeurs uniques
        .Cells(1, 1).Resize(UBound(MonDico.keys)).Value = Application.Transpose(MonDico.keys)
    End With
End Sub

Bonne soirée

 

[taratata]

merci Dranreb

au départ j'ai dans un tableau structuré [Tab_BNIC] en colonne 4 comprenant des chiffres. Elle contient des doublons.
Au final, je souhaite enregistrer cette colonne sans doublons dans un tableau array --> dim a_Taux(100) as variant.

 

[job75]

Bonsoir taratata, Bernard, Roblochon,

au départ j'ai dans un tableau structuré [Tab_BNIC] en colonne 4 comprenant des chiffres. Elle contient des doublons.
Au final, je souhaite enregistrer cette colonne sans doublons dans un tableau array --> dim a_Taux(100) as variant.

Cela n'est pas ce qui est dit au post #1 mais bon tant pis, on fera avec ça :

Sub SansDoublon()
Dim tablo, d As Object, i&, a, a_Taux(100)
tablo = [Tab_BNIC].Columns(4).Resize(, 2) 'matrice, plus rapide, au moins 2 éléments
Set d = CreateObject("Scripting.Dictionary")
For i = 1 To UBound(tablo)
    If tablo(i, 1) <> "" Then d(tablo(i, 1)) = ""
Next
If d.Count Then
    a = d.keys
    tri a, 0, UBound(a) 'facultatif
    For i = 0 To IIf(UBound(a) > UBound(a_Taux), UBound(a_Taux), UBound(a))
        a_Taux(i) = a(i)
    Next
End If
'---restitution dans la feuille pour tester---
[H2].Resize(, UBound(a_Taux)) = a_Taux
End Sub

Sub tri(a, gauc, droi) ' Quick sort
Dim ref, g, d, temp
ref = a((gauc + droi) \ 2)
g = gauc: d = droi
Do
    Do While a(g) < ref: g = g + 1: Loop
    Do While ref < a(d): d = d - 1: Loop
    If g <= d Then
      temp = a(g): a(g) = a(d): a(d) = temp
      g = g + 1: d = d - 1
    End If
Loop While g <= d
If g < droi Then Call tri(a, g, droi)
If gauc < d Then Call tri(a, gauc, d)
End Sub

A+

 

[mapomme]

Bonsoir à tous ,

Pour le fun, une version utilisant pricipalement les fonctions d'Excel.

Sub PasDeDoublon()
Dim n&, xrg As Range, Tablo     'le résultat est le tableau Tablo
Application.ScreenUpdating = False
With Sheets("Feuil1")
  n = .Columns.Count    'numéro de la dernière colonne
  Range("Tab_BNIC[Col 4]").Copy .Cells(1, n)    'copie de la colonne 4 sur la dernière colonne
  Set xrg = .Range(.Cells(1, n), .Cells(.Rows.Count, n).End(xlUp))    'le range copié dans la dernière colonne
  xrg.RemoveDuplicates 1, xlNo    'on ôte les doublons
  xrg.Sort xrg(1, 1), xlAscending, Header:=xlNo   'on trie
  Tablo = .Range(.Cells(1, n), .Cells(.Rows.Count, n).End(xlUp))     'le résultat est mis dans le tableau Tablo
  .Columns(n).Clear   'on efface la dernière colonne qui ne nous sert plus
  .Range(.Cells(5, "h"), .Cells(5, n)).Clear    'on efface les précédents résultats
  .Range("h5").Resize(, UBound(Tablo)) = Application.Transpose(Tablo)   'on affiche le résultat
End With
End Sub

 

[taratata]

Merci job75 , mapomme

la méthode de mapomme est courte, simple à comprendre. Elle s'appuie une la feuille. je vais tester s'il cette feuille doit être active!

la méthode de job75 est pas facile à appréhender, normale pour un novice. Elle s'appuie sur un deuxième tableau ce qui est parfait.

Pour ma compréhension, que signifie ces lignes

Déclaration de variables --> Pourquoi & i&
--> est ce une simple variable a de type variant

que signifie cette ligne a = d.keys


Pourquoi IIf dans cette ligne
For i = 0 To IIf(UBound(a) > UBound(a_Taux), UBound(a_Taux), UBound(a))

merci pour tes réponses job75

une bonne journée à vous deux

 

[taratata]

après tests - ceci est valable pour les deux codes job75 , mapomme
il s'avère que cela ne fonctionne pas, pour la toute première ligne
1er image est le tableau structuré
2ème image est le résultat après moulinette

personnellement j'utilise celui de job75 (via tableau)
j'ai changer
Tablo = [Tab_BNIC].Columns(4).Resize(, 2)
en
Tablo = [Tab_BNIC].Columns(4).Resize(, 1)

résultat idem

une idée?

 

[job75]

Dim i& c'est la même chose que Dim As Long.

IIf(UBound(a) > UBound(a_Taux), UBound(a_Taux), UBound(a)) permet de prendre la taille la plus petite des 2 tableaux.

 

[job75]

Pour votre liste dans la MsgBox vous pouvez utiliser :

Sub CreerListe1()
MsgBox Join(Application.Transpose([Tab_BNIC].Columns(4)), vbLf)
End Sub

Application.Transpose est limitée à 65536 lignes, au-delà utiliser :

Sub CreerListe2()
Dim tablo, i&, liste$
tablo = [Tab_BNIC].Columns(4).Resize(, 2)
For i = 1 To UBound(tablo) 'matrice, plus rapide, au moins 2 éléments
    liste = liste & vbLf & tablo(i, 1)
Next
MsgBox Mid(liste, 2)
End Sub

 

[mapomme]

Re,

une idée?

Oui. Disposer du vrai fichier sur lequel vous travaillez... Sur le fichier joint, cela semble fonctionner (après avoir bien sûr adaptés le nom du tableau et la colonne considérée !)

 

[taratata]

si je met

MsgBox List_obj_Provisoire.DataBodyRange.Columns(3).Address

j'obtient une plage lorsqu'il y redondance (plusieurs fois 12)

alors qu'il n'y a qu'une seul fois l'info (ex: 26)

pas d'affichage msgbox

c'est le même phénomène avec

    Last_Col = List_obj_Provisoire.ListColumns.Count
    MsgBox "Last_Col  " & Last_Col

 

[job75]

Vous avez pris la fâcheuse habitude de poser des questions à tire-larigot sans tenir le moindre compte des solutions qu'on vous donne.

Continuez comme ça taratata, on vous laissera tomber.

 

[taratata]

Sur vos fichier, cela fonctionne bien
sur le mien, voilà ce que j'obtiens

variables globales

' Tableau Dynamique pour ComboBox CB_TN -- CB_Dosage
Dim a_Taux() As Variant
Dim b_Dosage() As Variant

Lecture et traitement de la colonne Taux Nicotine

Private Sub CB_TN_a_Taux()
' -------------------------------  DEBUT  --------------------------------------------------------
' Le tableau type array a_Taux() référence les valeurs d'une colonne d'un tableau structuré cible.
' ----------------------------------  FIN  -------------------------------------------------------
' Le but est d'éliminer les doublons et d'effectuer un classement par ordre croissant
' Lecture de la colonne cible puis enregistrement dans un tableau array a()
' Appel Sub tri a, 0, UBound(a)

    Dim tablo, d As Object, i&, a, liste$

    Dim Feuille As Worksheet
    Dim List_obj_DIY_BNIC As ListObject
    Dim list_row As ListRow
    
    Set Feuille = Sheets("DIY_BNIC")
    Set List_obj_DIY_BNIC = Feuille.ListObjects("Tab_BNIC")

    tablo = [Tab_BNIC].Columns(4).Resize(, 2)           'matrice, plus rapide, au moins 2 éléments
    
    
    For i = 1 To UBound(tablo) 'matrice, plus rapide, au moins 2 éléments
        liste = liste & vbLf & tablo(i, 1)
    Next
    MsgBox Mid(liste, 2)
    
    
    Set d = CreateObject("Scripting.Dictionary")
    For i = 1 To UBound(tablo)
        If tablo(i, 1) <> "" Then d(tablo(i, 1)) = ""
    Next
        
    If d.Count Then
        a = d.Keys
        'MsgBox "ubound(a)" & UBound(a)
        ReDim a_Taux(UBound(a))                 ' Dimensionnement du tableau dynamique
        tri a, 0, UBound(a)
        
        For i = 1 To IIf(UBound(a) > UBound(a_Taux), UBound(a_Taux), UBound(a))
            ReDim Preserve a_Taux(i)            ' Enregitrement Data
            'MsgBox "ubound(a_Taux)" & UBound(a_Taux)
            a_Taux(i) = a(i)
            'MsgBox "Valeur -- a_Taux     " & a_Taux(i)
        Next
    
    End If

    ligne = ""
    For j = 1 To UBound(a_Taux)
        ligne = ligne & a_Taux(j) & Chr(10) & Chr(13)
    Next j
    MsgBox "Taux Nicotine -- a_Taux()" & Chr(10) & Chr(13) & Chr(10) & Chr(13) & ligne

    Erase a

End Sub

Lecture et traitement de la colonne Dosage VG/PG

Private Sub CB_Dosage_b_Dosage()

' -------------------------------  DEBUT  --------------------------------------------------------
' Le tableau type array a_Taux() référence les valeurs d'une colonne d'un tableau structuré cible.
' ----------------------------------  FIN  -------------------------------------------------------
' Le but est d'éliminer les doublons et d'effectuer un classement par ordre croissant
' Lecture de la colonne cible puis enregistrement dans un tableau array a()
' Appel Sub tri a, 0, UBound(a)

    Dim tablo, d As Object, i&, a, liste$

    Dim Feuille As Worksheet
    Dim List_obj_Provisoire As ListObject
    'Dim list_row As ListRow
    
    Set Feuille = Sheets("Provisoire")
    Set List_obj_Provisoire = Feuille.ListObjects("Tab_BNIC_Provisoire")
    Feuille.Activate
    ActiveSheet.Visible = xlSheetVisible


    Last_Col = List_obj_Provisoire.ListColumns.Count
    MsgBox "Last_Col  " & Last_Col
    Last_Ligne = (List_obj_Provisoire.Range.Rows.Count)
    MsgBox "Last_Ligne  " & Last_Ligne
    
    MsgBox List_obj_Provisoire.DataBodyRange.Columns(3).Address
    
    ' Sélectionne la colonne cible
    List_obj_Provisoire.ListColumns(3).DataBodyRange.Select    'la zone de données



    tablo = [Tab_BNIC_Provisoire].Columns(3).Resize(, 2)           'matrice, plus rapide, au moins 2 éléments
    
    
    
    For i = 1 To UBound(tablo) 'matrice, plus rapide, au moins 2 éléments
        liste = liste & vbLf & tablo(i, 1)
    Next
    MsgBox Mid(liste, 2)
    
    
    
    Set d = CreateObject("Scripting.Dictionary")
    For i = 1 To UBound(tablo)
        If tablo(i, 1) <> "" Then d(tablo(i, 1)) = ""
    Next
        
    If d.Count Then
        a = d.Keys
     '   MsgBox "ubound(a)" & UBound(a)
        ReDim b_Dosage(UBound(a))                 ' Dimensionnement du tableau dynamique
        tri a, 0, UBound(a)
        
        For i = 1 To IIf(UBound(a) > UBound(b_Dosage), UBound(b_Dosage), UBound(a))
            ReDim Preserve b_Dosage(i)            ' Enregitrement Data
     '       MsgBox "ubound(a_Taux)" & UBound(a_Taux)
            b_Dosage(i) = a(i)
     '       MsgBox "Valeur -- a_Taux     " & a_Taux(i)
        Next
    
    End If

    ligne = ""
    For j = 1 To UBound(b_Dosage)
        ligne = ligne & b_Dosage(j) & Chr(10) & Chr(13)
    Next j
    MsgBox "Taux Nicotine -- b_Dosage()" & Chr(10) & Chr(13) & Chr(10) & Chr(13) & ligne

    Erase a

    ' Déclaration du tableau structuté
    tablo_CB_Dosage = [b_Dosage]
    ' Lien RowSource
    CB_Dosage.List = tablo_CB_Dosage
End Sub

triage

Sub tri(a, gauc, droi) ' Quick sort
Dim ref, g, d, temp
ref = a((gauc + droi) \ 2)
g = gauc: d = droi
Do
    Do While a(g) < ref: g = g + 1: Loop
    Do While ref < a(d): d = d - 1: Loop
    If g <= d Then
      temp = a(g): a(g) = a(d): a(d) = temp
      g = g + 1: d = d - 1
    End If
Loop While g <= d
If g < droi Then Call tri(a, g, droi)
If gauc < d Then Call tri(a, gauc, d)
End Sub

si je sélectionne en Taux le choix 12 (présent plusieurs fois) - pas de soucis

si je sélectionne en Taux le choix 26 (1 fois) - rien en Dosage

tableau structuré Tab_BNIC

Le traitement du Tab_BNIC est lent (suppression de toute ligne n'étant pas égal au choix sélectionné) pour ensuite traiter la colonne Dosage (doublons) et y coller au comboBox Dosage.

Je vais enregistrer Tab_BNIC dans un array pour éliminer la lenteur et espérant qu'il fonctionne bien même s'il n'y a qu'un choix.

Pas de soucis Job75 - face à l'adversité, je suis plus fort
merci de votre aide... bonne route - Dieu vous bénisse

 

[taratata]

c'est ici que ce trouve le prob

MsgBox " UBound(tablo)       " & UBound(tablo)
    For i = 1 To UBound(tablo) 'matrice, plus rapide, au moins 2 éléments
        liste = liste & vbLf & tablo(i, 1)
    Next i
    MsgBox "Mid(liste, 2)       " & Mid(liste, 2)
    

    Set d = CreateObject("Scripting.Dictionary")
    For i = 1 To UBound(tablo)
        If tablo(i, 1) <> "" Then d(tablo(i, 1)) = ""
    Next i
        
    If d.Count Then
        a = d.Keys
        MsgBox "ubound(a)   " & UBound(a)
        ReDim b_Dosage(UBound(a))                 ' Dimensionnement du tableau dynamique
        tri a, 0, UBound(a)
        
        For i = 1 To IIf(UBound(a) > UBound(b_Dosage), UBound(b_Dosage), UBound(a))
            ReDim Preserve b_Dosage(i)            ' Enregitrement Data
            MsgBox "ubound(b_Dosage)" & UBound(b_Dosage)
            b_Dosage(i) = a(i)
            MsgBox "Valeur -- b_Dosage     " & b_Dosage(i)
        Next i
    
    End If

MsgBox " UBound(tablo) " & UBound(tablo) --> donne 4 ce qui est correcte
MsgBox "ubound(a) " & UBound(a) --> donne 3 ce qui est faux

donc l'erreur se situe ici a = d.Keys en liaison avec Set d = CreateObject("Scripting.Dictionary")