[VBA] Recherche dictionnaire sur 3 colonnes

Bonsoir,

Étant donné que j'utilise une source de données assez conséquente, j'opte systématiquement pour les dictionnaires pour réaliser des recherches.

Sauf que dans ma situation, je dois vérifier deux colonnes pour récupérer le résultat qui correspond et ça, je ne parviens pas à le faire.

J'ai beaucoup parcouru les sites internet, notamment http://boisgontierjacques.free.fr ; sans succès pour le moment.

Voici ce que j'essaie de faire :

Si le contenu de la cellule dans la colonne "Espèce" (feuille "Annexe_Bota") est trouvé dans la colonne "NOM_COMPLET_BDC" (feuille "BASE DE DONNEES FLORE") et que la valeur "Provence-Alpes-Côte-d'Azur" est trouvée (cette valeur peut changer, je l'ai inscrite en .cells(1,6) de la feuille "Annexe_Bota" pour le moment).

Alors écrire en colonne 4 (feuille "Annexe_Bota") ce qui se trouve en colonne "LB_TYPE_STATUT" de la feuille "BASE DE DONNEES FLORE"

Si c'est la valeur "France métropolitaine" qui est trouvée, alors écrire en colonne 5 ce qui se trouve en colonne "LB_TYPE_STATUT" de la feuille "BASE DE DONNEES FLORE"

Et pour la suite je pense que je pourrai adapter.

J'ai fait des tentatives de codes avec des dictionnaires, mais je ne pense pas bien m'y prendre.

Peut-on faire un dictionnaire contenant plusieurs colonnes "d'items" ?

Je joins un document plutôt simplifié normalement.

Bonne soirée !

A plus tard

Bonsoir,

tu peux concaténer le contenu de plusieurs colonnes pour faire une clé unique pour le dictionnaire.

Bonsoir,

En effet, ça devrait pouvoir marcher ! Merci !

Je vais essayer et je reviendrai avec la solution que j'aurai testé !

Bonne soirée

Bonjour,

J'ai essayé en tournant la macro ainsi :

Dim lrlf&, lclf&, lrbd&, a&, b&, lbts As Byte, ncbd As Byte, lbad As Byte, es As Byte, cdts As Byte, Dict1 As Object, _
tablo1, tablo2, tablo3, tablo4, tablo5, tab1, tab2, tab3

'Call opt_act
Set Dict1 = CreateObject("scripting.dictionary"): Set Dict2 = CreateObject("scripting.dictionary")
With bd
    lrbd = .Cells(.Rows.Count, 1).End(xlUp).Row
    ncbd = .Range("1:1").Find("NOM_COMPLET_BDC", LookIn:=xlValues).Column
    lbts = .Range("1:1").Find("LB_TYPE_STATUT", LookIn:=xlValues).Column
    lbad = .Range("1:1").Find("LB_ADM_TR", LookIn:=xlValues).Column
    cdts = .Range("1:1").Find("CD_TYPE_STATUT", LookIn:=xlValues).Column

    tablo1 = .Range(.Cells(2, ncbd), .Cells(lrbd, ncbd)): tablo2 = .Range(.Cells(2, lbts), .Cells(lrbd, lbts))
    tablo3 = .Range(.Cells(2, lbad), .Cells(lrbd, lbad)): tablo5 = .Range(.Cells(2, cdts), .Cells(lrbd, cdts))
        For a = LBound(tablo1) To UBound(tablo1)
            Dict1(tablo2(a, 1)) = (tablo1(a, 1) & tablo3(a, 1) & tablo5(a, 1))
        Next a
End With

With Sheets("Annexe_bota")
    .Cells(1, 4) = "Statut national": .Cells(1, 4).Interior.Color = RGB(217, 217, 217)
    .Cells(1, 5) = "Statut régional": .Cells(1, 5).Interior.Color = RGB(217, 217, 217)
    .Cells(1, 6) = "Statut ZNIEFF": .Cells(1, 6).Interior.Color = RGB(217, 217, 217)

    lrlf = .Cells(.Rows.Count, 1).End(xlUp).Row
    lclf = .Cells(1, .Columns.Count).End(xlToLeft).Column
    es = .Range("1:1").Find("Espèce", LookIn:=xlValues).Column
    cbval = .Cells(1, 8)

        ReDim tab1(1 To lrlf - 1, 1 To 1): ReDim tab2(1 To lrlf - 1, 1 To 1): ReDim tab3(1 To lrlf - 1, 1 To 1)
             tablo4 = .Range(.Cells(2, es), .Cells(lrlf, es))
                 For a = 1 To UBound(tablo4)
                 '.Cells(2, 6) = Dict1(tablo4(a, 1) & "France métropolitaine" & "PN") 'ligne test, ne pas tenir compte
                     If Dict1.exists(tablo4(a, 1) & "France métropolitaine" & "PN") Then tab1(a, 1) = Dict1(tablo4(a, 1)) Else tab1(a, 1) = "Sans statut"
                     If Dict1.exists(tablo4(a, 1) & cbval & "PR") Then tab2(a, 1) = Dict1(tablo4(a, 1)) Else tab2(a, 1) = "Sans statut"
                     If Dict1.exists(tablo4(a, 1) & cbval & "ZDET") Then tab3(a, 1) = Dict1(tablo4(a, 1)) Else tab3(a, 1) = "Sans statut"
                 Next a
            .Cells(2, 4).Resize(lrlf - 1, 1) = tab1: .Cells(2, 5).Resize(lrlf - 1, 1) = tab2: .Cells(2, 6).Resize(lrlf - 1, 1) = tab3
End With
'UserForm_correspondances.CB_Cells.BackColor = RGB(255, 255, 255)
'Call opt_fin
End Sub

Mais ça ne fonctionne pas ; Excel trouve systématiquement un résultat alors qu'il n'y en a pas.

Et quand il trouve un résultat, forcément, il inscrit la valeur concaténée. Je ne sais pas bien ce que je pourrais changer.

A plus tard !

Edit : Je joins un document mis à jour avec ce code et les changements apportés

Bonjour,

je pense que tu as une mauvaise compréhension de la manière dont fonctionne un dictionnaire (ou si tu as compris, tu ne l'utilises pas correctement). J'ai essayé de corriger, mais pas sûr d'avoir bien compris ce que tu veux comme résultat, notamment la distinction entre protection régionale et ZNIEFF et ce que tu veux voir affiché dans ce cas.

Bonjour,

notamment la distinction entre protection régionale et ZNIEFF et ce que tu veux voir affiché dans ce cas

Cela dépend d'une variable, je l'avais écris en .cells(1,6) mais elle a disparu dans mes tests.

Habituellement elle est inscrite dans un Userform qui est affiché pendant l'exécution de la macro.

Excel doit rechercher les résultat qui correspondent à la région/le département recherché(e).

Du coup vous n'aviez pas l'info pour comprendre la distinction entre protection régionale et ZNIEFF...

Mais grâce à ce que vous avez envoyé, j'ai pu comprendre où se situaient mes erreurs et maintenant la macro fonctionne exactement comme je l'espérais !

Voici le document ci-joint si vous souhaitez y jeter un œil, sinon voici le code :

Dim lrlf&, lclf&, lrbd&, a&, b&, lbts As Byte, ncbd As Byte, lbad As Byte, es As Byte, cdts As Byte, Dict1 As Object, _
tablo1, tablo2, tablo3, tablo4, tablo5, tab1, tab2, tab3

Call Set_Feuilles 'temporaire
Call opt_act
Set Dict1 = CreateObject("scripting.dictionary")
With bd
    lrbd = .Cells(.Rows.Count, 1).End(xlUp).Row
    ncbd = .Range("1:1").Find("NOM_COMPLET_BDC", LookIn:=xlValues).Column
    lbts = .Range("1:1").Find("LB_TYPE_STATUT", LookIn:=xlValues).Column
    lbad = .Range("1:1").Find("LB_ADM_TR", LookIn:=xlValues).Column
    cdts = .Range("1:1").Find("CD_TYPE_STATUT", LookIn:=xlValues).Column

    tablo1 = .Range(.Cells(2, ncbd), .Cells(lrbd, ncbd)): tablo2 = .Range(.Cells(2, lbts), .Cells(lrbd, lbts))
    tablo3 = .Range(.Cells(2, lbad), .Cells(lrbd, lbad)): tablo5 = .Range(.Cells(2, cdts), .Cells(lrbd, cdts))
        For a = LBound(tablo1) To UBound(tablo1)
            Dict1(tablo1(a, 1) & tablo3(a, 1) & tablo5(a, 1)) = tablo2(a, 1)
        Next a
End With

With Sheets("Annexe_bota")
cbval = .Cells(1, 8)
    .Cells(1, 4) = "Statut national": .Cells(1, 4).Interior.Color = RGB(217, 217, 217)
    .Cells(1, 5) = "Statut régional": .Cells(1, 5).Interior.Color = RGB(217, 217, 217)
    .Cells(1, 6) = "Statut ZNIEFF": .Cells(1, 6).Interior.Color = RGB(217, 217, 217)

    lrlf = .Cells(.Rows.Count, 1).End(xlUp).Row
    lclf = .Cells(1, .Columns.Count).End(xlToLeft).Column
    es = .Range("1:1").Find("Espèce", LookIn:=xlValues).Column

        ReDim tab1(1 To lrlf - 1, 1 To 1): ReDim tab2(1 To lrlf - 1, 1 To 1): ReDim tab3(1 To lrlf - 1, 1 To 1)
             tablo4 = .Range(.Cells(2, es), .Cells(lrlf, es))
                 For a = 1 To UBound(tablo4)
                     If Dict1.exists(tablo4(a, 1) & "France métropolitaine" & "PN") Then tab1(a, 1) = Dict1(tablo4(a, 1) & "France métropolitaine" & "PN") Else tab1(a, 1) = "Sans statut"
                     If Dict1.exists(tablo4(a, 1) & cbval & "PR") Then tab2(a, 1) = Dict1(tablo4(a, 1) & cbval & "PR") Else tab2(a, 1) = "Sans statut"
                     If Dict1.exists(tablo4(a, 1) & cbval & "ZDET") Then tab3(a, 1) = Dict1(tablo4(a, 1) & cbval & "ZDET") Else tab3(a, 1) = "Sans statut"
                 Next a
            .Cells(2, 4).Resize(lrlf - 1, 1) = tab1: .Cells(2, 5).Resize(lrlf - 1, 1) = tab2: .Cells(2, 6).Resize(lrlf - 1, 1) = tab3
End With
'UserForm_correspondances.CB_Cells.BackColor = RGB(255, 255, 255)
Call opt_fin
End Sub

Encore un grand merci pour votre aide !

Bonne journée