[VBA] Recherche "xlPart" dans un tableau virtuel

Bonjour,

J'ai ajouté le pseudonyme d'h2so4 car il est à l'origine du code sur lequel je travaille ces temps-ci.

Ce code consiste à comparer des tableaux virtuels pour récupérer les informations qui m'intéressent de manière très rapide ; la comparaison se fait sur les valeurs strictement identiques.

Est-il possible de réaliser une comparaison sur des valeurs proches ?

En l'occurrence, j'ai essai de comparer des données dans lesquelles il est renseigné l'année avec des données pour lesquelles l'année n'est pas renseignée. Mais ce sont exactement les mêmes.

Le code en question se présente comme ça :

Public Sub maj_bsfl_2()
Dim i&, lrbf&, lcbf&, lrtx&, ns As Byte, nv As Byte, et As Byte, cib As Byte, cib1 As Byte, cho As Byte, a&, tablo(), dict As Object, tablo1, tablo2, tablo3

    Set dict = CreateObject("scripting.dictionary")

    With Sheets("TAXREF")
        lrtx = .UsedRange.SpecialCells(xlCellTypeLastCell).Row
        cib = .Range("1:1").Find("NOM_VALIDE", LookIn:=xlValues, Lookat:=xlWhole).Column
        cib1 = .Range("1:1").Find("NOM_COMPLET", LookIn:=xlValues, Lookat:=xlWhole).Column
        tablo1 = .Range(.Cells(2, cib1), .Cells(lrtx, cib1))
        tablo2 = .Range(.Cells(2, cib), .Cells(lrtx, cib))
        For i = LBound(tablo1) To UBound(tablo1)
            dict(tablo1(i, 1)) = tablo2(i, 1)
        Next i
    End With

    With Sheets("baseflor_maj_2020_04_18")
        lrbf = .UsedRange.SpecialCells(xlCellTypeLastCell).Row
        lcbf = .UsedRange.Columns.Count
        cho = .Range("1:1").Find("CHOROLOGIE", LookIn:=xlValues, Lookat:=xlWhole).Column
        .Columns(cho).Insert
        .Columns(cho).Insert
        .Cells(1, cho) = "NOM_VALIDE_TAXREF" 'Utilisation de la variable "cho" qui est = à (cho -2) après insertion colonnes
        .Cells(1, cho + 1) = "Erreur_TAXREF"

        ns = .Range("1:1").Find("NOM_SCIENTIFIQUE", LookIn:=xlValues, Lookat:=xlWhole).Column
        nv = .Range("1:1").Find("NOM_VALIDE_TAXREF", LookIn:=xlValues, Lookat:=xlWhole).Column
        et = .Range("1:1").Find("Erreur_TAXREF", LookIn:=xlValues, Lookat:=xlWhole).Column

        ReDim tablo(1 To lrbf - 1, 1 To 1)
        tablo3 = .Range(.Cells(2, ns), .Cells(lrbf, ns))

    For a = 1 To UBound(tablo3)
        If dict.exists(tablo3(a, 1)) Then
            tablo(a, 1) = dict(tablo3(a, 1))
        Else
            tablo(a, 1) = "-" ' tablo3(a, 1)
            .Cells(a + 1, et) = "Erreur"
        End If
    Next a
    .Cells(2, nv).Resize(lrbf - 1, 1) = tablo
    End With
End Sub

Je joins un document, mais je doute qu'il soit utile, pour réaliser les tests il faudrait les BDD complètes, qui sont un peu trop lourdes...

Je peux faire un document complet joint via cjoin si besoin !

A plus tard !

Bonsoir,

sur base des données que tu as fournies, il me semble que si tu utilises la colonne LB_NOM_VALIDE au lieu de NOM_VALIDE pour TAXREF et LB_NOM_SCIENTIFIQUE au lieu de NOM_SCIENTIFIQUE pour baseflor, tu as résolu le problème non ?

Bonsoir,

Je commence à être fatigué...

C'est effectivement le cas, j'avais modifié les colonnes pour éviter certaines erreurs au départ, mais là c'est exactement ce qu'il me fallait.

Merci pour votre aide !

Je vais probablement avoir une troisième question sur cette macro prochainement, car je ne trouve rien qu'il puisse y répondre pour le moment.

Bonne fin de journée !

Bonjour,

Pour effectuer des comparaisons rapides sur des valeurs exactes , il y a dictionary

Pour des valeurs approximatives (contenu dans) , je ne connais que Filter(Table,mot) si la table une seule dimension.

Je l'utilise pour des recherches multi-mots du type ET/OU

Option Compare Text
Dim f, Choix()
Private Sub UserForm_Initialize()
   Set f = Sheets("bd")
   Choix = Application.Transpose(f.Range("a2:a" & f.[A65000].End(xlUp).Row))
   Me.ListBox1.List = Choix
End Sub

Private Sub TextBox1_Change()
   Set d1 = CreateObject("scripting.dictionary")
   mots = Split(Trim(Me.TextBox1), ",")
   For Each m In mots
     mots2 = Split(Trim(m), " ")
     tbl = Choix
     For i = LBound(mots2) To UBound(mots2)
       tbl = Filter(tbl, mots2(i), True, vbTextCompare)
     Next i
     For i = LBound(tbl) To UBound(tbl): d1(tbl(i)) = "": Next i
   Next m
   If d1.Count > 0 Then Me.ListBox1.List = d1.keys
   Me.ListBox1.ListIndex = -1
End Sub

Boisgontier