find mutlicritères

[Pierrot75]

Bonjour, dans le fichier ci-joint, j'ai un onglet "Test RDE" qui représente une liste Source dont je veux vérifier l'existence de ses composants dans l'onglet "Liste fichier" qui représente une base de données.
Ce test est basé sur 2 critères, le premier étant l'intitulé d'un document et le second son extension (pdf, xls...)
Suivant si le test est VRAI, je voudrai colorer en vert la cellule contenant le document recherché dans l'onglet "Test RDE" et en rouge, si le document n'est pas trouvé.

J'avais trouvé un code qui me semblait pas mal mais cela n'a pas l'air de fonctionner.

MErci d'avance de votre aide.

 

[Paf]

Re : find mutlicritères

Bonjour

modification du code fourni (sans doute pas la solution la plus rapide):

Public Sub TestExistenceFicher()
 Dim Trouve As Boolean, feuillecible As Worksheet, a, WS As Worksheet, BD As Range, i As Long, j As Long
 Dim RefDoc As String, Extension As String
 Set feuillecible = Worksheets("Test RDE")                       'Adressage Onglet CIBLE
 Set WS = Worksheets("ListeFichiers")                       'Adressage OngletSource
 Set BD = WS.Range("a9:E" & WS.Range("a" & Rows.Count).End(xlUp).Row)
 a = BD
 Trouve = False
 'Recherche existence document dans liste globale
    i = 2
    Do While feuillecible.Cells(i, "A") <> ""
        RefDoc = feuillecible.Cells(i, "A")
        Extension = feuillecible.Cells(i, "D")
        For j = 1 To UBound(a, 1)
            If a(j, 1) = RefDoc And UCase(a(j, 5)) = UCase(Extension) Then
                Trouve = True
                Exit For
            End If
        Next j
        If Trouve Then
            feuillecible.Cells(i, "A").Interior.ColorIndex = 4
        Else
            feuillecible.Cells(i, "A").Interior.ColorIndex = 3
        End If
        Trouve = False
        i = i + 1
    Loop
End Sub

à tester
A+

 

[Pierrot75]

Re : find mutlicritères

Super, ça fonctionne! un grand merci Paf!

 

[Pierrot75]

Re : find mutlicritères

Bonjour,

Pour faire suite à cette discussion, je fais appel à vos lumières car j'aurai besoin de construire un "mode" dégradé à partir du fichier ci-joint.

Effectivement, par défaut, j'indique une extension XLSB si je rencontre une référence de document commençant par GBV et PDF dans les autres cas.

 i = 2
    Do While feuillecible.Cells(i, "B") <> ""
        If Left(feuillecible.Cells(i, "B").Value, 3) = "GBV" Then
            feuillecible.Cells(i, "E").Value = "xlsb"
        Else
            feuillecible.Cells(i, "E").Value = "pdf"
        End If
        i = i + 1
    Loop

Une fois l’extension attribuée, je procède à une recherche dans l’onglet Liste Fichier en comparant les couples formés par la référence et l’extension du document recherché.

Par défaut, je vais donc chercher une GBV au format XLSB.
Si la recherche est infructueuse, je souhaiterai effectuer une nouvelle recherche pour savoir si cette GBV existerait au format PDF. Si tel est le cas, alors, je souhaite changer l’extension XLSB, attribuée initialement, avec l’extension pdf.

Exemple; dans la PJ, la GBV R00006 en XLSB n'est pas trouvée dans l'onglet Liste fichier, ce qui est normal. Par contre, il existe une GBV R00006 en PDF et je souhaiterai qu'elle soit considéréer TROUVE dans le code ci-dessous.

'Recherche existence document dans onglet “Liste fichier”
    Set WS = Worksheets("ListeFichiers")                       'Adressage OngletSource
    Set BD = WS.Range("a9:H" & WS.Range("a" & Rows.Count).End(xlUp).Row)
    a = BD
    Trouve = False

    i = 2
    Do While feuillecible.Cells(i, "B") <> ""
        RefDoc = feuillecible.Cells(i, "B")
        Extension = feuillecible.Cells(i, "E")
        
        For j = 1 To UBound(a, 1)
            If a(j, 1) = RefDoc And UCase(a(j, 5)) = UCase(Extension) Then
                Trouve = True
                Exit For
            End If
        Next j
        
        If Trouve Then
            Cells(i, "C") = a(j, 2)
            Cells(i, "D") = a(j, 4)
            Cells(i, "F") = a(j, 6) & a(j, 7)
            Cells(i, "B").Hyperlinks.Add Anchor:=Cells(i, "B"), Address:=Cells(i, "F"), TextToDisplay:=Cells(i, "B").Value
        Else
            feuillecible.Cells(i, "B").Interior.ColorIndex = 36
        End If
        Trouve = False
        i = i + 1
    Loop

Merci d'avance de votre contribution.