XL 2013 un dictionnaire qui ne fonctionne pas- listbox sans doublons (source tableau structuré)

patricktoulon

XLDnaute Barbatruc
Bonjour a tous
j'ai fait un tout petit exemple pour un membre sur 2007
ayant enfin réparé mon pc je suis sur 2013
et là c'est la confusion totale dans mon esprit le dico ne fonctionne pas quand je prends pas la colonne 1 du tableau
je met des témoins et même un msgbox pour m'afficher le compte rendu du job
pas moyen les doublons sont gardés

je suis assez désappointé 😂🤔
une capture du résultat avec la colonne 1("prenom")
1634970528558.png


capture du resultat avec la colonne 2 ("nom")
1634970597541.png


ci joint un classeur avec 2 petit tableaux structurés et 3 petit userforms pour l'exemple
l'exemple 1 et 2 tri les doublons sur une colonnes (quand c'est pas la colonne 1 ca ne fonctionne pas)
l'exemple 3 lui tri sur les valeurs de la ligne entière il fonctionne

 

Pièces jointes

  • listbox tableau structuré exemple sans doublons pour ChTi160.xlsm
    24.1 KB · Affichages: 5
Solution
C
Re,

Arff, je crois avoir trouvé 😜

Le souci se situe sur cette ligne
Code:
      dico(tablo(i, 1)) = ""    ' le dico sert juste a controler on ne se sert pas de son .keys ou .items

Tu ne tiens pas compte de la colonne maitre 😱

A remplacer par
Code:
      dico(tablo(i, colMaitre)) = ""    ' le dico sert juste a controler on ne se sert pas de son .keys ou .items

Voilà en entier
VB:
Function GetTableNoDouble(rng As Range, Optional colMaitre As Variant = 1, Optional vertical As Boolean = False)
  Dim a&, i&, dico As Object, tbl(), tablo, c&, z
  tablo = rng.Value
  texte = "colonne controlée :colonne(""" & colMaitre & """)"""
  Set dico = CreateObject("scripting.dictionary")
  If Not IsNumeric(colMaitre) Then colMaitre =...
C

Compte Supprimé 979

Guest
Salut Patrick

Effectivement il y a un souci si on prend la colonne nom et je rassure toi, je ne vois pas non plus pourquoi 🤔

Tellement plus simple avec une collection 😜
VB:
Function GetTableNoDouble(rng As Range, Optional colMaitre As Variant = 1, Optional vertical As Boolean = False)
  Dim a&, i&, Unique As New Collection, tbl(), tablo, c&, z
  tablo = rng.Value
  texte = "colonne controlée :colonne(""" & colMaitre & """)"""
  If Not IsNumeric(colMaitre) Then colMaitre = Range(rng.ListObject.Name).ListObject.ListColumns(colMaitre).Index
  On Error Resume Next
  For i = 1 To UBound(tablo)
    texte = texte & vbCrLf & tablo(i, colMaitre) & ";  "
    z = " ligne du tableau " & i & ":   non gardé"
    Unique.Add i, CStr(tablo(i, colMaitre))
    If Err.Number = 0 Then
      z = " ligne du tableau " & i & ":   gardé"
      'comme on redim preserve et que seul la derniere dimmension est redimentionnable alors on redim transposé
      a = a + 1: ReDim Preserve tbl(1 To UBound(tablo, 2), 1 To a)
      For c = 1 To UBound(tablo, 2): tbl(c, a) = tablo(i, c): Next
    Else
      Err.Clear
    End If
    texte = texte & z
  Next
  On Error GoTo 0
  GetTableNoDouble = tbl
End Function

A+
 
Dernière modification par un modérateur:

patricktoulon

XLDnaute Barbatruc
bonjour bruno
oui aussi mais j’aimerais bien résoudre l’énigme du problème du dico
car pour moi il n'y a aucune raison c' est un truc vraiment bizarre
j'ajoute le modèle collection dans mon fichier
c'est pour distribuer en tant qu'exemple aux demandes similaires

l'énigme est toujours a résoudre dans les userforms exemple(1 et 2)
 

Pièces jointes

  • listbox tableau structuré exemple sans doublons.xlsm
    26.5 KB · Affichages: 2
C

Compte Supprimé 979

Guest
Re,

Arff, je crois avoir trouvé 😜

Le souci se situe sur cette ligne
Code:
      dico(tablo(i, 1)) = ""    ' le dico sert juste a controler on ne se sert pas de son .keys ou .items

Tu ne tiens pas compte de la colonne maitre 😱

A remplacer par
Code:
      dico(tablo(i, colMaitre)) = ""    ' le dico sert juste a controler on ne se sert pas de son .keys ou .items

Voilà en entier
VB:
Function GetTableNoDouble(rng As Range, Optional colMaitre As Variant = 1, Optional vertical As Boolean = False)
  Dim a&, i&, dico As Object, tbl(), tablo, c&, z
  tablo = rng.Value
  texte = "colonne controlée :colonne(""" & colMaitre & """)"""
  Set dico = CreateObject("scripting.dictionary")
  If Not IsNumeric(colMaitre) Then colMaitre = Range(rng.ListObject.Name).ListObject.ListColumns(colMaitre).Index
  For i = 1 To UBound(tablo)
    texte = texte & vbCrLf & tablo(i, colMaitre) & ";  "
    z = " ligne du tableau " & i & ":   non gardé"
    If Not dico.exists(tablo(i, colMaitre)) Then
      dico(tablo(i, colMaitre)) = ""    ' le dico sert juste a controler on ne se sert pas de son .keys ou .items
      z = " ligne du tableau " & i & ":   gardé"
      'comme on redim preserve et que seul la derniere dimmension est redimentionnable alors on redim transposé
      a = a + 1: ReDim Preserve tbl(1 To UBound(tablo, 2), 1 To a)
      For c = 1 To UBound(tablo, 2): tbl(c, a) = tablo(i, c): Next
    End If
    texte = texte & z
  Next
  GetTableNoDouble = tbl
End Function

Ca semble fonctionner chez moi

Code excellent, pas étonné venant de ta part ;) hop je mets dans ma bibliothèque de codes

@+
 

patricktoulon

XLDnaute Barbatruc
Bon après un petit déjeuné a ma taille :p

bruno prend plutôt cet exemple il est complet
dans l'appel on a la possibilité de l'appeler et de recevoir un tableau vertical
ca peut servir selon le besoins
VB:
Private Sub CommandButton1_Click()
    Dim tbl, table As Range
    Set table = Range("Tableau1")
    'en 2d argument soit l'index soit le nom de la colonne (dans le header)
    ' en 3e argument true ou false si on le veut vertical ou horizontal
    ' tbl = GetTableNoDouble(table, "prenom")
    tbl = GetTableNoDouble(table, "nom")
    With ListBox1
        .ColumnCount = table.Columns.Count
        ' si on a omis ou mis le 3e argument "vertical" a false  c'est un tableau transposé on utilise ".Column" et non ".list"
        ' sinon on utilise ".List"
        .Column = tbl
    End With
    MsgBox texte
End Sub

Function GetTableNoDouble(rng As Range, Optional colMaitre As Variant = 1, Optional vertical As Boolean = False)
    Dim a&, i&, dico As Object, tbl(), tablo, c&, z
    tablo = rng.Value
    texte = "colonne controlée :colonne(""" & colMaitre & """)"""
    Set dico = CreateObject("scripting.dictionary")
    If Not IsNumeric(colMaitre) Then colMaitre = Range(rng.ListObject.Name).ListObject.ListColumns(colMaitre).Index
    For i = 1 To UBound(tablo)
        texte = texte & vbCrLf & tablo(i, colMaitre) & ";  "
        z = " ligne du tableau " & i & ":   non gardé"
        If Not dico.exists(tablo(i, colMaitre)) Then
            dico(tablo(i, colMaitre)) = ""    ' le dico sert juste a controler on ne se sert pas de son .keys ou .items
            z = " ligne du tableau " & i & ":   gardé"
            'comme on redim preserve et que seul la derniere dimmension est redimentionnable alors on redim transposé
            a = a + 1: ReDim Preserve tbl(1 To UBound(tablo, 2), 1 To a)
            For c = 1 To UBound(tablo, 2): tbl(c, a) = tablo(i, c): Next
        End If
        texte = texte & z
    Next
    If vertical Then tbl = Application.Transpose(tbl)
    GetTableNoDouble = tbl
End Function

et le tiens avec la collection
VB:
Option Explicit

Dim texte
Private Sub CommandButton1_Click()
    Dim tbl, table As Range
    Set table = Range("Tableau1")
    ' si on a omis ou mis le 3e argument "vertical" a false  c'est un tableau transposé on utilise ".Column" et non ".list"
        ' sinon on utilise ".List"
      ' tbl = GetTableNoDouble(table, "prenom")    'en 2d argument soit l'index soit le nom de la colonne (dans le header)
    tbl = GetTableNoDouble(table, "nom", True)   'en 2d argument soit l'index soit le nom de la colonne (dans le header)
    With ListBox1
        .ColumnCount = table.Columns.Count
         ' si on a omis ou mis le 3e argument "vertical" a false  c'est un tableau transposé on utilise ".Column" et non ".list"
        ' sinon on utilise ".List"
        '.Column = tbl
        .List = tbl
        End With
    MsgBox texte
End Sub
Function GetTableNoDouble(rng As Range, Optional colMaitre As Variant = 1, Optional vertical As Boolean = False)
'utilisation d'une collection 'by Bruno45
    Dim a&, i&, Unique As New Collection, tbl(), tablo, c&, z
    tablo = rng.Value
    texte = "colonne controlée :colonne(""" & colMaitre & """)"""
    If Not IsNumeric(colMaitre) Then colMaitre = Range(rng.ListObject.Name).ListObject.ListColumns(colMaitre).Index
    On Error Resume Next
    For i = 1 To UBound(tablo)
        texte = texte & vbCrLf & tablo(i, colMaitre) & ";  "
        z = " ligne du tableau " & i & ":   non gardé"
        Unique.Add i, tablo(i, colMaitre)
        If Err.Number = 0 Then
            z = " ligne du tableau " & i & ":   gardé"
            'comme on redim preserve et que seul la derniere dimmension est redimentionnable alors on redim transposé
            a = a + 1: ReDim Preserve tbl(1 To UBound(tablo, 2), 1 To a)
            For c = 1 To UBound(tablo, 2): tbl(c, a) = tablo(i, c): Next
        Else
            Err.Clear
        End If
        texte = texte & z
    Next
    On Error GoTo 0
    If vertical Then tbl = Application.Transpose(tbl)
    GetTableNoDouble = tbl
End Function
 

Discussions similaires

Réponses
18
Affichages
483

Statistiques des forums

Discussions
311 711
Messages
2 081 796
Membres
101 817
dernier inscrit
carvajal