Macro fonctionnelle mais ne remontant pas tous les résultats

Bonjour,

Dans le cadre de ma base de donnée, je viens de me rendre compte qu'une de mes macro ne fonctionne pas correctement.

En effet celle ci doit me remonter des prénoms et noms de personnel mais certain d'entre eux ne remontent pas.

le nom pourtant que je recherche ici est dans 10 enregistrements dont 7 respectant le critère

 If TblBd(i, 1) = ID  dont ID = 1 via ID = Val("1"): N = 0

le soucis vient de cette partie

 If Err.Number = 0 Then

Else
      Err.Clear
    End If

si je supprime le code ci-dessus je me retrouve avec ma listbox avec certains champs vide mais le nom manquant remonte bien..

Et voici la macro dans son intégralité

Public Sub Listing_PI()
 Dim MaCollection As New Collection
 NomTableau = "Links14"
 TblBd = Sheets("Investigators").ListObjects(NomTableau).DataBodyRange.Value
 ID = Val("1"): N = 0
 ColVisu = Array(3, 4)
 LargeurCol = Array(50, 45)
 PInvest_List.ColumnCount = Sheets("Investigators").Range(NomTableau).Columns.Count - 5
 PInvest_List.ColumnWidths = Join(LargeurCol, ";")
   Dim tb_tri()
    Dim clé1_tri As Variant, clé2_tri As Variant
    Dim i1 As Integer, i2 As Integer, j As Integer, C As Integer

  Dim Tbl()
  ' En cas d'erreur
  On Error Resume Next
  ' Boucle
  For i = 1 To UBound(TblBd)

    MaCollection.Add TblBd(i, 4), TblBd(i, 4)
    ' Vérifier si erreur = doublon
    If Err.Number = 0 Then
    ' Sinon on  ajoute
     If TblBd(i, 1) = ID Then
        N = N + 1: ReDim Preserve Tbl(1 To UBound(TblBd, 2), 1 To N)
                 C = 0
        For Each k In ColVisu

          C = C + 1: Tbl(C, N) = TblBd(i, k)
          Next k

     End If
    Else
      Err.Clear
    End If

  Next i
  If N > 0 Then Me.PInvest_List.Column = Tbl Else Me.PInvest_List.Clear

With Sheets("DashBoard").PInvest_List
        'Création d'un tableau dynamique trié par Nom/Prénom
        ReDim tb_tri(.ListCount, .ColumnCount)
        For i1 = 0 To .ListCount - 1
           clé1_tri = .List(i1, 1) & .List(i1, 0)

            j = 0
            For i2 = 0 To .ListCount - 1
            clé2_tri = .List(i2, 1) & .List(i2, 0)
                If clé1_tri > clé2_tri Then j = j + 1
            Next i2
            For C = 0 To .ColumnCount - 1
                tb_tri(j, C) = .List(i1, C)

            Next C
        Next i1

        'Rechargement Listbox triée
        .ListFillRange = Empty
        .List = tb_tri

    End With
End Sub

une idée d'où mon soucis pourrait venir?

Merci par avance pour votre aide

bonne journée

Bonjour,

Essayez de remplacer "Err.clear" par "On error goto 0 ", ceci réinitialise la gestion d'erreur et permet ainsi de traiter les nouvelles erreurs rencontrées.

Cdlt

si je fais cela une erreur remonte:

Bonjour,

Difficile de répondre sans avoir la moindre idée de ce que fait l'outil, et sans support pour tester.

Mais de votre côté, pour trouver l'erreur, vous devriez faire tourner votre code en pas à pas (avec la touche F8) en relevant à chaque fois les valeurs des variables, ainsi vous pourriez localiser assez facilement le problème.

Faites aussi cela: Affichez la fenêtre "Exécution" dans le module visual basic puis , dans votre code, après cette ligne:

clé1_tri = .List(i1, 1) & .List(i1, 0)

ajoutez celle-ci (que vous supprimerez après avoir résolu le problème):

Debug.print clé1_tri

Lors du lancement de la macro, toutes les valeurs prises par la "clé1_tri" (jusqu'à l'erreur rencontrée) seront afficher, vous verrez bien à partir de quel moment cela coince .

Mais, vu que l'erreur est renvoyée au niveau de la clé, c'est que le problème est situé en amont, vous pouvez donc placer, dans le code, d'autres lignes avec "Debug.print" suivi du nom de la variable à tester, pour analyser d'autres points à contrôler.

Bonne analyse.

Cdlt

bonjour le fil, avec une fonction personnalisée "Exists"

Function Exists(coll As Collection, key As String) As Boolean
     'https://excelmacromastery.com/excel-vba-collections/
     On Error GoTo EH
     IsObject (coll.Item(key))
     Exists = True
EH:
End Function

Public Sub Listing_PI()
     Dim MaCollection As New Collection
     NomTableau = "Links14"
     tblbd = Sheets("Investigators").ListObjects(NomTableau).DataBodyRange.Value
     ID = Val("1"): N = 0
     ColVisu = Array(3, 4)
     LargeurCol = Array(50, 45)
     PInvest_List.ColumnCount = Sheets("Investigators").Range(NomTableau).Columns.Count - 5
     PInvest_List.ColumnWidths = Join(LargeurCol, ";")
     Dim tb_tri()
     Dim clé1_tri As Variant, clé2_tri As Variant
     Dim i1 As Integer, i2 As Integer, j As Integer, C As Integer

     Dim Tbl()
     For i = 1 To UBound(tblbd)
          If Not Exists(MaCollection, tblbd(1, 4)) Then
               MaCollection.Add tblbd(i, 4), tblbd(i, 4)
               If tblbd(i, 1) = ID Then
                    N = N + 1: ReDim Preserve Tbl(1 To UBound(tblbd, 2), 1 To N)
                    C = 0
                    For Each k In ColVisu
                         C = C + 1: Tbl(C, N) = tblbd(i, k)
                    Next k

               End If
          End If
     Next i
     If N > 0 Then Me.PInvest_List.Column = Tbl Else Me.PInvest_List.Clear

     With Sheets("DashBoard").PInvest_List
          'Création d'un tableau dynamique trié par Nom/Prénom
          ReDim tb_tri(.ListCount, .ColumnCount)
          For i1 = 0 To .ListCount - 1
               clé1_tri = .List(i1, 1) & .List(i1, 0)

               j = 0
               For i2 = 0 To .ListCount - 1
                    clé2_tri = .List(i2, 1) & .List(i2, 0)
                    If clé1_tri > clé2_tri Then j = j + 1
               Next i2
               For C = 0 To .ColumnCount - 1
                    tb_tri(j, C) = .List(i1, C)

               Next C
          Next i1

          'Rechargement Listbox triée
          .ListFillRange = Empty
          .List = tb_tri

     End With
End Sub

Bonjour,

je vais tenter l'analyse pas à pas pour trouver la sources du problème mais je sais par avance que cela ne vient pas du tri mais avant .

si je tente un Debug.Print TblBd(i, k) => déja le probleme est là et ne remonte pas l'enregistrement en question

si je fais un simple: If Err.Number <> 0 Then Resume Next

la listbox semble complète mais avec lignes vides

j'ai tenté à tout hasard l'approche de BsAlv mais a me renvoi une erreur de ref avec la fonction exists/

ca bloque direct ici: If Not Exists(MaCollection, tblbd(i, 4))

bonjour,

après 789 messages, vous savez déjà que c'est plus facile si vous ajouter un fichier anonimysé. Ce n'est pas à moi de créer un. Ma macro, je l'ai écrit complètement "à première vue"

avec un dictionaire au lieu d'un collection

Public Sub Listing_PI()
     Dim Dict
     Set Dict = CreateObject("scripting.dictionary")
     Dict.comparemode = vbTextCompare

     NomTableau = "Links14"
     tblbd = ActiveSheet.ListObjects(1).DataBodyRange.Value  '>>>>>>>>>> pour mon teste, changer après !!!!
     ID = Val("1"): N = 0
     ColVisu = Array(3, 4)
     LargeurCol = Array(50, 45)
     PInvest_List.ColumnCount = Sheets("Investigators").Range(NomTableau).Columns.Count - 5
     PInvest_List.ColumnWidths = Join(LargeurCol, ";")
     Dim tb_tri()
     Dim clé1_tri As Variant, clé2_tri As Variant
     Dim i1 As Integer, i2 As Integer, j As Integer, C As Integer

     Dim Tbl()
     For i = 1 To UBound(tblbd)
          If Not Dict.Exists(tblbd(1, 4)) Then
               Dict(tblbd(i, 4)) = tblbd(i, 4)
               If tblbd(i, 1) = ID Then
                    N = N + 1: ReDim Preserve Tbl(1 To UBound(tblbd, 2), 1 To N)
                    C = 0
                    For Each k In ColVisu
                         C = C + 1: Tbl(C, N) = tblbd(i, k)
                    Next k

               End If
          End If
     Next i

Merci à vous pour votre proposition toutefois cela ne retourne désormais que le premier nom mais plus le reste.<p>

je peux essayer de faire un fichier à part mais il me faudrait exporter certains elements de ma base

Bonjour,

Rentrant de congés j'ai donc préparé un fichier test qui reproduit le soucis

la macro Listing_PI() fait remonter les noms des personnes dont L'ID est 1 mais tous ne remonte pas

exemple Guido dans la feuille Investigators que j'ai surligné en jaune

l'erreur semble venir de mon code et plus précisément If Err.Number = 0 Then

merci par avance pour votre aide

Bonjour,

personne pour me mettre sur une piste?

merci par avance

bonne journée

re, (un problème = quand il y a un match)

Sub Les1()
     Dim aOut, aA, ptr, X
     aA = Sheets("investigators").ListObjects("Links14").DataBodyRange.Value
     Set dict = CreateObject("scripting.dictionary")
     dict.comparemode = vbTextCompare
     For i = 1 To UBound(aA)
          If aA(i, 1) = 1 Then dict(aA(i, 3) & "|" & aA(i, 4)) = Array(aA(i, 3), aA(i, 4)) ': Exit For
     Next
     aOut = Application.Index(dict.items, 0, 0)

     With Sheets("DashBoard").PInvest_List
          .ListFillRange = Empty
        If dict.Count Then .List = aOut

     End With
End Sub

Bonjour,

Ce que je vois, un problème de clé, là:

Cdlt

Edit: de plus, passez les variables "INTERGER" à "LONG"

Merci à vous deux pour vos retours

j'ai testé votre macro BSALV et celle ci fonctionne

toutefois comment procéder désormais afin qu'un triage orthographique puisse se faire sur le nom?

re,

j'utilise la plage "libre" (à vérifier !!!, si vous avez >=excel_2021, cela n'est pas nécessaire) en dessous votre tableau "Links14" et la triage se fait avec "contact_Name"

Sub Les1()
     Dim LO, aOut, aA, ptr, X
     Set LO = Sheets("investigators").ListObjects("Links14")     'votre tableau
     aA = LO.DataBodyRange.Value             'lire les données
     Set dict = CreateObject("scripting.dictionary")     'le dictionaire
     dict.comparemode = vbTextCompare        'majuscules=miniscules
     For i = 1 To UBound(aA)                 'boucle les données
          If aA(i, 1) = 1 Then dict(aA(i, 3) & "|" & aA(i, 4)) = Array(aA(i, 3), aA(i, 4))     'seulement les ID=1
     Next

     If dict.Count > 0 Then                  'il y a des ID=1
          b1 = (dict.Count = 1)              'seulement 1 ID = problème, il faut le doubler
          If b1 Then dict.Add dict.Count, dict.items()(0)     's'il n'y a qu'un match, doublez-le, pour éviter des problèmes de "transposer"
          aOut = Application.Index(dict.items, 0, 0)     'lire les items du dictionaire
          With LO.Range.Offset(LO.Range.Rows.Count + 5).Resize(UBound(aOut), UBound(aOut, 2))     'utiliser l'espace en dessous le tableau
               .Value = aOut                 'coller ces "items"
               .Sort .Range("B1"), Header:=xlNo     'trier sur le "contact_Name"   (utiliser A1 pour le "FirstName")
               aOut = .Value                 'lire le résultat trié
               .ClearContents                'supprimer cette plage temporaire
          End With
     End If

     With Sheets("DashBoard").PInvest_List
          .ListFillRange = Empty
          If dict.Count Then                 'il y a des IDs
               .List = aOut                  'assigner les données
               If b1 Then .RemoveItem 1      's'il n'a qu'un donnée, supprimer le doublon
          Else
               .Clear                        'RAZ
          End If
     End With
End Sub

Re,

Fonctionne nickel grand merci je n'ai plus qu'a tenter d'implanter ca dans mon fichier pour tester

enfin derniere question

quand on clique sur une lettre cela descend vers le prochain prenom commencant par la lettre

est ce possible que la recherche se fasse sur la 2 eme colonne soit le nom?

re, oui, mais je ne comprend pas où vous faites le clicque.

Dans l'exemple, vous changez quelque chose dans cellule K10 et le listbox se positionne.

Private Sub Worksheet_Change(ByVal Target As Range)
     Dim r     As Integer
     With Target
          If .Address = "$K$10" Then         '---> vous modifiez quelque chose en cellule K10
               s = .Value
               If s <> "" Then
                    With Sheets("DashBoard").PInvest_List     'votre listbox
                         aA = Application.Index(.List, 0, 2)     'lire 2ieme colonne = "Contact_Name"
                         For i = 1 To UBound(aA)     'boucler ces noms, jusqu'au premier qui est orthographique plus grand
                              If StrComp(aA(i, 1), s, 1) < 0 Then r = i Else Exit For
                         Next
                           .TopIndex = Application.Max(0, r - 5)     'positioner la première ligne visible du listbox 5 lignes plus tôt
                         .ListIndex = r 'Application.Min(r, UBound(aA) - 1)     'selecter cette ligne
                     End With

               End If
          End If
     End With
End Sub

Sub eon()
     Application.EnableEvents = True
End Sub

Bonsoir

merci pour votre fichier que je vais regarder

ce que je voulais dire c'est si on sélectionne une ligne dans listbox et que l'on tape sur la lettre g par exemple ca va descendre à la prochaine ligne dont le prenom commence par un g sauf que me concernant je souhaiterais que cela se fasse sur la colonne des noms

re, comme ça ?

tout simplement parfait!!

merci à vous pour cette grande aide