Eviter les doublons de remontées dans macro

Bonjour,

j'ai une macro fonctionnelle (voir ci-dessous) qui me permet de faire remonter des informations dans msgbox pour le moment

toutefois dans le tableau t_staff il y a des doublons car un nom peut etre rattaché à plusieurs choses

du coup comment éviter ce doublon impactant la recherche dans projets?

aA(i, 3) doit eviter les doublons mais comment faire?

En gros

Public Sub Staff_List_DblClick(ByVal lstncel As MSForms.ReturnBoolean)

Set TblBd = Sheets("Staff").ListObjects("T_Staff")
  aA = TblBd.DataBodyRange.Value
  For i = 1 To UBound(aA)

     If aA(i, 3) = UCase(Staff_List.Value) Then

    NomTableau2 = "Projects"
 Set TblBd2 = Sheets("Projects").ListObjects("Projects")
  aB = TblBd2.DataBodyRange.Value
  For j = 1 To UBound(aB)
    If (aB(j, 1) = aA(i, 1)) Then
If (aB(j, 13) <> "Rejected" And aB(j, 13) <> "Closed" And aB(j, 13) <> "Abandonned") Then
   MsgBox (aB(j, 3))
    End If
End If
    Next j

    End If
   Next i

    End Sub

merci par avance

bonjour Darkangel,

avec un dictionaire, vous pouvez éviter cela.

ok merci à vous

toutefois comment mettre cela en place?

j'ai rajouté au début

Set MonDico = CreateObject("Scripting.Dictionary")

mais si j'ajoute

 Sheets("DashBoard").Staff_List.List = MonDico.keys

cela stoppe l'affichage et vide ma Staff_List

Public Sub Staff_List_DblClick(ByVal lstncel As MSForms.ReturnBoolean)

Set TblBd = Sheets("Staff").ListObjects("T_Staff")
    Set MonDico = CreateObject("Scripting.Dictionary")
  aA = TblBd.DataBodyRange.Value

For i = 1 To UBound(aA)

     If aA(i, 3) = UCase(Staff_List.Value) Then

    NomTableau2 = "Projects"
 Set TblBd2 = Sheets("Projects").ListObjects("Projects")

  aB = TblBd2.DataBodyRange.Value
  For j = 1 To UBound(aB)

    If (aB(j, 1) = aA(i, 1)) Then
If (aB(j, 13) <> "Rejected" And aB(j, 13) <> "Closed" And aB(j, 13) <> "Abandonned") Then
   MsgBox (aB(j, 3))
    End If
End If
    Next j
  Sheets("DashBoard").Staff_List.List = MonDico.keys
    End If

   Next i

    End Sub

j'ai essayé en procédant autrement (car ne maitrise pas trop la notion de dico) mais je n'arrive pas à mes fins

En effet je tente de vérifier si la valeur existe dans le dico pour ne pas la prendre en compte

If MonDico.Exists(Staff_List.Value) Then
Else
MonDico.Add Staff_List.Value, i
End If

mais cela ne fonctionne toujours pas

Public Sub Staff_List_DblClick(ByVal lstncel As MSForms.ReturnBoolean)
Dim MonDico As Object
Dim i As Long, j As Long

Set TblBd = Sheets("Staff").ListObjects("T_Staff")
Set MonDico = CreateObject("Scripting.Dictionary")
aA = TblBd.DataBodyRange.Value

'Sheets("DashBoard").Staff_List.List = MonDico.keys
For i = 1 To UBound(aA)

If aA(i, 3) = UCase(Staff_List.Value) Then

If MonDico.Exists(Staff_List.Value) Then
Else
MonDico.Add Staff_List.Value, i
End If

NomTableau2 = "Projects"
Set TblBd2 = Sheets("Projects").ListObjects("Projects")

aB = TblBd2.DataBodyRange.Value
For j = 1 To UBound(aB)

If (aB(j, 1) = aA(i, 1)) Then
If (aB(j, 13) <> "Rejected" And aB(j, 13) <> "Closed" And aB(j, 13) <> "Abandonned") Then
MsgBox (aB(j, 3))
End If
End If
Next j

End If

Next i

End Sub

personne?

re,

sans fichier, c'est plus difficile à s'imaginer le contenu des cellules.

Voici

12test.xlsm (42.26 Ko)

re,

comme ceci ....

15test-90.xlsm (49.55 Ko)

Bonjour,

Merci pour ce retour rapide

En effet cela semble fonctionner et je vais donc devoir analyser le comment!

je n'avais encore jamais utilisé la fonction split ...

par contre si je voulais pousser plus loin et afficher disons le statut

 If (aB(j, 13) <> "Rejected" And aB(j, 13) <> "Closed" And aB(j, 13) <> "Abandonned") Then s = s & "," & aB(j, 1) & " " & aB(j, 13) 'son status est okay = ajouter au string
          End If

cela fonctionne mais comment gérer l'affichage en colonne?

re,

il n'y a pas de doublons dans numéros des projets du tableau1, je suppose (?!?), donc on n'a pas besoin d'un dictionaire.

C'est dans le tableau2 qu'il y a des doublons mais pas dans le tableau 1

avez vous vu mon post précèdent cependant ?

re sur votre poste précédente,

9test-90.xlsm (50.94 Ko)

merci cela fonctionne toutefois comment indiquer la valeur de largeur des colonnes

dans ma première macro j'ai par exemple LargeurCol = Array(50, 45)

Bonjour Darkangel, le fil, le forum,

Concernant la largeur des colonnes de "Liste_Projects" ...

     aB = Sheets("Projects").Range("Tableau1").Value     'vos données
     For j = 1 To UBound(aB)
          If IsNumeric(Application.Match(CStr(aB(j, 1)), sp, 0)) Then     'c'est un des ses projets
               If (aB(j, 13) <> "Rejected" And aB(j, 13) <> "Closed" And aB(j, 13) <> "Abandonned") Then
                  dict.Add dict.Count, Array(aB(j, 1), aB(i, 13))     'son status est okay = ajouter au string
               End If
          End If
     Next j
    Liste_Projets.ColumnWidths = ("30, 100")      ' << Largeur des colonnes de "Liste_Projects"

Bizz

top merci :)

Bonjour Darkangel, le fil, le forum,

J'ai déplacé "Liste_Projets.ColumnWidths .... " après la boucle "For ... " car, la largeur des colonnes se définissait à chaque ajout d'un item.

Voir le code précédent.

Bizz

Merci je l'avais corrigé de mon coté !

toutefois meme si cela fonctionne dans le fichier test quand je tente de l'appliquer dans mon fichier mais il est vrai dans un userform la deuxième colonne ne s'affiche meme pas

bien que ce soit indiqué dans le dictionnaire: Dict.Add Dict.Count, Array(aB(j, 3), aB(j, 8))

tout simplement ignoré alors que la case aB(j, 8) est bien complété et jamais vide

image

je vais tenter de repliquer l'erreur dans le fichier test

re,

il faut modifier le nombre des colonnes avec le columncount (maintenant j'en ai 4 !!!). Normallement, une fois que tout est comme il fau, le nombre de colonnes et leur largeurs ne changent plus, donc peut-être, c'est mieux d'ajuster cela ailleurs.

   With Me.Liste_Projets
               .ColumnCount = 4              'nombre de colonnes du listbox !!!!
               .ColumnWidths = "30;50;30;50"     'largeur des colonnes
               .List = Application.Index(dict.items, 0, 0)     'liste avec le projets sélectionnés
 
20test-90.xlsm (53.31 Ko)

Exact merci!!!

tout simple mais efficace

Grand merci pour votre aide!

Rechercher des sujets similaires à "eviter doublons remontees macro"