Tableau Lire Deuxième Colonne SI Condition VRAI dans Première Colonne

Bonjour à tous,

Je suis sûr que vous allez tous vous f...tre de moi mais je tourne en rond et Toi Expert tu pourras certainement corriger la virgule qui me manque :-)

Je veux vérifier si certains fichiers sont présent sur le disque dur.

Si ils sont présents je veux les inscrire sous forme de liste à un endroit précis de ma feuille.

ça marche avec ce code :

Sub Test2()
'++++++++++++++++++++++++++++++++++++++++++++++++
Application.ScreenUpdating = False
'++++++++++++++++++++++++++++++++++++++++++++++++
Dim Tableau(2)
'++++++++++++++++++++++++++++++++++++++++++++++++
On Error GoTo FinTest
'++++++++++++++++++++++++++++++++++++++++++++++++
Tableau(0) = Dir("C:\Code\01 Dossier Test\01 Sous-Dossier Test 1\01*Nom1*.pdf")
Tableau(1) = Dir("C:\Code\01 Dossier Test\01 Sous-Dossier Test 2\01*Nom2*.pdf")
Tableau(2) = Dir("C:\Code\01 Dossier Test\01 Sous-Dossier Test 3\01*Nom3*.pdf")
'++++++++++++++++++++++++++++++++++++++++++++++++
Range("B8:C10").Clear
Dim Fich As Variant
Dim i As Integer
i = 8
For Each Fich In Tableau
    If Fich <> "" Then
        Range("B" & i).Value = Fich
        Range("C" & i).Value = "True"
        i = i + 1
    End If
Next Fich
'++++++++++++++++++++++++++++++++++++++++++++++++
Exit Sub
FinTest:
MsgBox "Aucun fichier n'a été trouvé", vbCritical, "Erreur"
'++++++++++++++++++++++++++++++++++++++++++++++++
End Sub

Mais je ne veux pas voir le nom du fichier mais un nom qui lui est attribué.

Voici mon code :

Sub Test()
'++++++++++++++++++++++++++++++++++++++++++++++++
Application.ScreenUpdating = False
'++++++++++++++++++++++++++++++++++++++++++++++++
Dim Tableau(2, 1)
'++++++++++++++++++++++++++++++++++++++++++++++++
On Error GoTo FinTest
'++++++++++++++++++++++++++++++++++++++++++++++++
Tableau(0, 0) = Dir("C:\Users\restd\OneDrive\Documents\Leveugle\Code\01 Dossier Test\01 Sous-Dossier Test 1\01*Nom1*.pdf")
Tableau(0, 1) = "Def1"
Tableau(1, 0) = Dir("C:\Users\restd\OneDrive\Documents\Leveugle\Code\01 Dossier Test\01 Sous-Dossier Test 2\01*Nom2*.pdf")
Tableau(1, 1) = "Def2"
Tableau(2, 0) = Dir("C:\Users\restd\OneDrive\Documents\Leveugle\Code\01 Dossier Test\01 Sous-Dossier Test 3\01*Nom3*.pdf")
Tableau(2, 1) = "Def3"
'++++++++++++++++++++++++++++++++++++++++++++++++
Range("B8:D10").Clear
Dim Fich As Variant
Dim i As Integer
Dim row As ListRow
i = 8
For Each Fich In Tableau
    If Fich <> "" Then
        Range("B" & i).Value = Tableau(i - 8, 0)
        Range("C" & i).Value = Tableau(i - 8, 1)
        Range("D" & i).Value = "True"
        i = i + 1
    End If
Next Fich
'++++++++++++++++++++++++++++++++++++++++++++++++
Exit Sub
FinTest:
MsgBox "Aucun fichier n'a été trouvé", vbCritical, "Erreur"
'++++++++++++++++++++++++++++++++++++++++++++++++
End Sub

Et là... C'est le drame...

Je ne comprends pas comment lire seulement la première colonne, Si la valeur de cette colonne remplis la condition, renvoyer la valeur de la deuxième colonne...

Merci d'avance à Toi Expert ;-)

Séba

Bonjour,

solution 1: préciser la colonne que l'on veut parcourir :

For Each Fich In Application.Index(Tableau, , 2)
.../...
Next Fich

solution 2: utiliser deux tableaux:

T1(0) = Dir("C:\Users\restd\OneDrive\Documents\Leveugle\Code\01 Dossier Test\01 Sous-Dossier Test 1\01*Nom1*.pdf")
T2(0) = "Def1"
T1(1) = Dir("C:\Users\restd\OneDrive\Documents\Leveugle\Code\01 Dossier Test\01 Sous-Dossier Test 2\01*Nom2*.pdf")
T2(1) = "Def2"
T1(2) = Dir("C:\Users\restd\OneDrive\Documents\Leveugle\Code\01 Dossier Test\01 Sous-Dossier Test 3\01*Nom3*.pdf")
T2(2) = "Def3"
'++++++++++++++++++++++++++++++++++++++++++++++++
Range("B8:D10").Clear
Dim Fich As Variant
Dim i As Integer
Dim row As ListRow
i = 8
For Each Fich In T1
    If Fich <> "" Then
        Range("B" & i).Value = T1(i - 8)
        Range("C" & i).Value = T2(i - 8)
        Range("D" & i).Value = "True"
        i = i + 1
    End If
Next Fich

et sûrement d'autres solutions...

A+

Merci beaucoup à AlgoPlus qui est mon héros du jour

Bon merci encore à AlgoPlus

Voici mon code final ...

J'ai dû faire une petite entourloupe car la référence de la deuxième colonne ne suivait pas si le fichier n'était pas trouvé...

Si quelqu'un à une autre idée plus conventionnelle je suis preneur !

Étant un jeune Padawan du code VBA j'essaye de comprendre et d'optimiser chaque étape, mais en autodidacte ce n'est pas simple.

Sub Test3()
'++++++++++++++++++++++++++++++++++++++++++++++++
Application.ScreenUpdating = False
'++++++++++++++++++++++++++++++++++++++++++++++++
Dim Tableau(2, 1)
Dim Fich As Variant
Dim i, j As Integer
'++++++++++++++++++++++++++++++++++++++++++++++++
On Error GoTo FinTest
'++++++++++++++++++++++++++++++++++++++++++++++++
Tableau(0, 0) = Dir("C:\Code\01 Dossier Test\01 Sous-Dossier Test 1\01*Nom1*.pdf")
Tableau(0, 1) = "Def1"
Tableau(1, 0) = Dir("C:\Code\01 Dossier Test\01 Sous-Dossier Test 2\01*Nom2*.pdf")
Tableau(1, 1) = "Def2"
Tableau(2, 0) = Dir("C:\Code\01 Dossier Test\01 Sous-Dossier Test 3\01*Nom3*.pdf")
Tableau(2, 1) = "Def3"
'++++++++++++++++++++++++++++++++++++++++++++++++
Range("B8:D13").Clear
i = 8
j = 8
For Each Fich In Application.Index(Tableau, , 1)
    If Fich <> "" Then
        Range("B" & i).Value = Fich
        Range("C" & i).Value = Tableau(j - 8, 1)
        Range("D" & i).Value = "True"
        i = i + 1
        j = j + 1
    Else
        j = j + 1
    End If
Next Fich
'++++++++++++++++++++++++++++++++++++++++++++++++
Exit Sub
FinTest:
MsgBox "Aucun fichier n'a été trouvé", vbCritical, "Erreur"
'++++++++++++++++++++++++++++++++++++++++++++++++
End Sub

Une autre approche sans tableau qu'on remplit d'abord puis qu'on parcours. On traite au fur et à mesure :

.../...
Range("B8:D13").Clear
i = 8
For a= 1 to 3
    Var0_0 = Dir("C:\Code\01 Dossier Test\01 Sous-Dossier Test 1\01*Nom" & a & "*.pdf")
    Var0_1 = "Def" & a

    If Var0_0 <> "" Then
        Range("B" & i).Value = Var0_0
        Range("C" & i).Value = Var0_1
        Range("D" & i).Value = "True"
        i = i + 1
    End If
Next a
.../...

Non testé...

A+