Tester plusieurs conditions comprises dans un range

Bonjour,

Je cherche à supprimer un ensemble de fichiers s'ils ne sont pas présents dans la liste de mon workbook (qui va de A1 à A60).

Application.ScreenUpdating = False
Set Principal = ThisWorkbook
    DerLigne = ThisWorkbook.Sheets("PIECES").Cells(Application.Rows.Count, 1).End(xlUp).Row
       Repertoire = ThisWorkbook.Path
        ChDir Repertoire
        xFichier = Dir("*.xlsx")
            Do While xFichier <> ""
            If xFichier <> Principal.Name Then

                    For m = DerLigne To 1 Step -1
            If xFichier <> ThisWorkbook.Sheets("PIECES").Cells(m, 1).Value Then
                Kill xFichier
            End If
            Next m

            End If
    xFichier = Dir
    ActiveWorkbook.Close savechanges:=True 'Enregistrement des changements dans les fichiers
Loop
Application.ScreenUpdating = True
End Sub

La partie qui coince est entre les lignes vides. Ça supprime donc le fichier... s'il est différent de mon A60. Évidemment, j'aimerais que ça vérifie l'ensemble des valeurs dans le range A1:A60 avant de décider ou non de supprimer le fichier !

Une idée ? Merci d'avance !

Bonjour Kit, bonjour le forum,

Peut-être comme ça (non testé) :

Sub Macro1()
Dim Principal As Workbook
Dim derligne As Integer
Dim Repertoire As String
Dim xFichier As String
Dim TEST As Boolean

Application.ScreenUpdating = False
Set Principal = ThisWorkbook
derligne = Sheets("PIECES").Cells(Application.Rows.Count, 1).End(xlUp).Row
Repertoire = ThisWorkbook.Path
ChDir Repertoire
xFichier = Dir("*.xlsx")
Do While xFichier <> ""
    If xFichier <> ThisWorkbook.Name Then
        For m = 1 To derligne
            If xFichier = Sheets("PIECES").Cells(m, 1).Value Then TEST = True
        Next m
        If TEST = False Then Kill xFichier: TEST = False
    End If
    xFichier = Dir
    'ActiveWorkbook.Close savechanges:=True 'Enregistrement des changements dans les fichiers
Loop
Application.ScreenUpdating = True
End Sub

La déclaration des variables n'est pas obligatoire mais je te conseille vivement de le faire pour éviter toute confusion dans le code...

Bonjour,

La solution de ThauThème à l'air nickel. Autre solution à tester pour si tu le souhaites.

If Range("A1:A" & DerLigne).Find(xFichier, , xlValues, , xlByRows) Is Nothing Then
    Kill xFichier
End If

A plus !

Whaoh, quelle rapidité, merci

La solution de ThauThème ne convient pas : certains fichiers sont supprimés, mais pas tous (testée sur un pool de 500+ fichiers avec une seule cellule remplie, il reste plus de 450 fichiers après avoir lancé la macro).

En revanche l'altération de Braters semble parfaitement fonctionner (un seul et unique fichier après passage de la macro).

Perso j'étais parti sur un truc bancal à base de n = n+1 à chaque cellule si le nom du fichier ne correspond pas puis faire un test sur la valeur de n et mon nombre de conditions en fin de boucle pour supprimer ou non le fichier, mais c'est long et foireux.

Dernière question : Mettons qu'on ne m'ait fourni qu'une partie du nom du fichier à conserver (par exemple "cerise" sachant que je devrai conserver les fichiers "cerise1.xlsx", "cerise_2.xlsx" et "cerise 3.xlsx").

Est-il possible de modifier le code de Braters en ce sens ?

Cela doit être possible, dans ton fichier, étant donné que tu n'as que le mot "Cerise", dans ta cellule de ta colonne A, tu rentres "Cerise" ou "Cerise.xlsx" ?

Bon, j'ai parlé trop vite : je viens de tester avec 67 noms de fichiers (recopiés à la main pour l'occasion) et... ça les supprime tous.

Le code actuel :

    Sub SupFile()
    Dim Principal As Workbook
    Dim derligne As Integer
    Dim Repertoire As String
    Dim xFichier As String

    Application.ScreenUpdating = False
    Set Principal = ThisWorkbook
    derligne = Sheets("PIECES").Cells(Application.Rows.Count, 1).End(xlUp).Row
    Repertoire = ThisWorkbook.Path
    ChDir Repertoire
    xFichier = Dir("*.xlsx")
    Do While xFichier <> ""
        If xFichier <> ThisWorkbook.Name Then
            If Range("A1:A" & derligne).Find(xFichier, , xlValues, , xlByRows) Is Nothing Then
        Kill xFichier
            End If
        End If
        xFichier = Dir
    Loop
    Application.ScreenUpdating = True
    End Sub

J'ai mis un point d'arrêt à la fin, derligne est bien égal à 67, il a donc bien lecture des noms sur la bonne feuille.

Petit up !

Désolé je pensais ton problème résolu, je n'ai pas compris quel est le problème ?

Une fois les différents noms de fichiers dans ma page, la macro supprime tous les fichiers. Pourtant la liste est bien lu (derLigne = 67).

Comment saisis-tu les noms des fichiers dans ta colonne A ? Es-tu sur que tous tes fichiers sont en ".xlsx" et pas en ".xlsm" ?

Chez moi avec un test sur 2 fichiers plus celui ou il y a la macro, dans lequel je saisis le nom d'un des deux fichiers, la macro fonctionne et supprime bien celui dont je n'ai pas saisi le nom.

Il faut que le nom de ton fichier soit identique au nom de ta cellule pour que cela fonctionne.

a plus

Braters a écrit :

Comment saisis-tu les noms des fichiers dans ta colonne A ? Es-tu sur que tous tes fichiers sont en ".xlsx" et pas en ".xlsm" ?

Copié/collé des noms des fichiers dans les cellules

C'est à dire que dans ta cellule tu as "Cerise" ou "Cerise.xlsx" ? Il faut "Cerise.xlsx" pour que cela fonctionne.

essaye ceci pour tester la macro :

Sub SupFile()
    Dim Principal As Workbook
    Dim derligne As Integer
    Dim Repertoire As String
    Dim xFichier As String

    Application.ScreenUpdating = False
    Set Principal = ThisWorkbook
    derligne = Sheets("PIECES").Cells(Application.Rows.Count, 1).End(xlUp).Row
    Repertoire = ThisWorkbook.Path
    ChDir Repertoire
    xFichier = Dir("*.xlsx")
    Do While xFichier <> ""
    MsgBox "xFichier = " & xFichier
        If xFichier <> ThisWorkbook.Name Then
            If Range("A1:A" & derligne).Find(xFichier, , xlValues, , xlByRows) Is Nothing Then
                MsgBox xFichier & " est supprimé"
                Range("B" & Range("B" & Rows.Count).End(xlUp).Row + 1) = xFichier
        'Kill xFichier
            End If
        End If
        xFichier = Dir
    Loop
    Application.ScreenUpdating = True
End Sub

tu pourra voir ce qui ne marche pas !

Les noms sont plus compliqués que "Cerise", mais j'ai bien mis l'extension .xlsx à chaque fois.

Là ça m'a envoyé deux message box à chaque fois ("xFichier = blabla.xlsx" puis "blabla.xlsx est supprimé") et m'a listé 451 fichiers (sur 516) dans la colonne B, sachant que j'ai 67 fichiers listés dans ma colonne A (sans entête).

Ce qui nous fait 64 fichiers restants sur les 67 voulus si je comprend bien, cela vient surement du fait qu'il y a une différence entre le nom du fichier et le nom saisi dans la cellule ! Peut être un espace apres le ".xlsx" ou bien une lettre oubliée etc...

Autant pour moi, après vérification j'avais des doublons qui s'étaient glissés dans la liste !

J'adopte ton script (sans messages box et l'écriture de la liste )

Merci beaucoup !