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

 

[taratata]

il s'agit du dictionnaire commençant par 0
l'index du array a commence donc à 0

c'est pour cela que la 1er entrée n'est pas prise en compte dans array b_Dosage

j'ai enregistré le contenu array ab dans array ac

If d.Count Then
        ab = d.Keys
        MsgBox "ubound(ab) -+-+-+  " & UBound(ab)
        ReDim ac(UBound(ab) + 1)
        For n = 0 To UBound(ab)
            MsgBox "ab(n)        " & Chr(10) & Chr(13) & _
                   "Position    " & n & Chr(10) & Chr(13) & _
                   "Valeur      " & ab(n)
                   ac(n + 1) = ab(n)
        Next n

        For n = 1 To UBound(ac)
            MsgBox "ac(n)        " & Chr(10) & Chr(13) & _
                   "Position    " & n & Chr(10) & Chr(13) & _
                   "Valeur      " & ac(n)
        Next n

        MsgBox "ubound(ac) -+-+-+  " & UBound(ac)
        ReDim b_Dosage(UBound(ac))              ' Dimensionnement du tableau dynamique
        tri ac, LBound(ac), UBound(ac)
        'Prendre la taille la plus petite des 2 tableaux.
        For i = 1 To IIf(UBound(ac) > UBound(b_Dosage), UBound(b_Dosage), UBound(ac))
            ReDim Preserve b_Dosage(i)            ' Enregitrement Data
            MsgBox "ubound(b_Dosage)" & UBound(b_Dosage)
            b_Dosage(i) = ac(i)
            MsgBox "Valeur -- b_Dosage     " & b_Dosage(i)
        Next
    
    End If

 

[Ednoork]

Bonjour,
à adapter les colonnes à ton fichier (ici tout ce fait de A1 à la dernière ligne de A

 

[laurent950]

Bonsoir,

Option Compare Text
Sub SupLignesEnDoublons()
Dim a() As Variant
   ' Tableau 2D en colonne 4
   a = Range(Cells(2, 1), Cells(7, 4))
   ' Suppression des doublons dans la colonne "Choisie"
   col = 2
   a = SupLignesDoublons(a, col)
   ' Restitution du tableau 2D sans les lignes en doublons
   Cells(10, 1).Resize(UBound(a), UBound(a, 2)).Value2 = a
   ' Restitution du tableau 2D sans les lignes en doublons :
   '     - Ici que la colonne choisie
   Cells(16, 2).Resize(UBound(a, 1)) = Application.Index(a, , 2)
  
End Sub

Function SupLignesDoublons(Tbl, col)
  deb = LBound(Tbl)                         ' ............ Premiere ligne du tableau
  fin = UBound(Tbl)                         ' ............ Derniere ligne du tableau
  cold = LBound(Tbl, 2)                     ' ............ Premiere Colonne du tableau
  colf = UBound(Tbl, 2)                     ' ............ Derniere Colonne du tableau
 
  ' Compte le nombre de ligne du tableau (eliminant les doublons de celui-ci)
  ReDim Preserve Tbl(LBound(Tbl, 1) To UBound(Tbl, 1), LBound(Tbl, 2) To UBound(Tbl, 2) + 1)
  For i = LBound(Tbl, 1) To UBound(Tbl, 1)
     For j = i + 1 To UBound(Tbl, 1)
        If Tbl(i, col) = Tbl(j, col) Then
            Tbl(i, UBound(Tbl, 2)) = "Doublon"
            Tbl(j, UBound(Tbl, 2)) = "Doublon"
        End If
    Next j
  Next i
 
  ' Compteur Nb de champs sans doublons
    Dim cpt As Long
    For i = LBound(Tbl, 1) To UBound(Tbl, 1)
        If Tbl(i, UBound(Tbl, 2)) <> "Doublon" Then
            cpt = cpt + 1
        End If
    Next i
 
  ' Creation d'un nouveau tableau temporaire
  Dim t()
 
  ' Redimension de se nouveau tableau temporaire.
  ReDim t(LBound(Tbl, 1) To cpt, cold To colf)
 
  ' Transfert des lignes sans doublons dans le tableau temporaire.
  cpt = 1
  For i = deb To fin
    If Tbl(i, UBound(Tbl, 2)) <> "Doublon" Then
      For k = cold To colf
            t(cpt, k) = Tbl(i, k)
      Next k
      cpt = cpt + 1
      If cpt > UBound(t, 1) Then
        cpt = cpt - 1
        Exit For
      End If
    End If
  Next i
 
  ' Transfert du tableau temps si non vides
  If cpt > 0 Then
    SupLignesDoublons = t()
  Else
    ' si le tableau est vide
    Dim a(): ReDim a(1 To 1, cold To colf)
    SupLignesDoublons = a()
  End If
End Function

Ps : C'est aussi Possible de conserver les 2 Tableaux affin de garder une trace et de comparer par la suite
se qui a était effacer comme je l'ai laisser dans le fichier excel avec les champs en doublons si cela à
un intérêt, Mais pas fait pour cette macro. (Inspiré de la Source Boisgontier = Merci pour ces nombreux exemple fort utile)
dont j'ai modifier pour cette exemple en fonction de la demande
cdt
Laurent

 

[taratata]

Merci Ednoork, laurent950
une bonne journée