Boucle For sur 100 000 lignes

Y compris Power BI, Power Query et toute autre question en lien avec Excel
w
whereisbryan
Membre habitué
Membre habitué
Messages : 145
Inscrit le : 4 janvier 2018
Version d'Excel : 2016 FR

Message par whereisbryan » 26 juin 2019, 16:56

re,
Sub GetFilesInFolder()
Dim WS As Worksheet
Dim FSO As Scripting.FileSystemObject
Dim SourceFolderName As String, DestinationFolderName As String
Dim SourceFolder As Scripting.folder, SubFolder As Scripting.folder
Dim FileItem As Scripting.file
Dim FileNamesArray() As String
Dim i As Long, iLig As Long, NbLig As Long, FileNameValue As Long

    Set WS = Worksheets("Sheet1")
    
    SourceFolderName = "C:\Users\Desktop\Test\"
    
    
    Set FSO = New Scripting.FileSystemObject
    Set SourceFolder = FSO.GetFolder(SourceFolderName)
    
    ReDim FileNamesArray(1 To SourceFolder.Files.Count)

    NbLig = WS.Cells(WS.Rows.Count, "A").End(xlUp).Row
    
    Application.ScreenUpdating = False
    
    dern = Sheets(1).Range("A1").End(xlDown).Row
    Dim tableau()
    ReDim tableau(dern + 1, 2)
    
    For x = 2 To dern
        tableau(x - 2, 0) = Sheets(1).Cells(x, 1)
        tableau(x - 2, 1) = Sheets(1).Cells(x, 2)
    Next
    
    For iLig = 0 To dern
        i = 0
        For Each FileItem In SourceFolder.Files
            i = i + 1
            FileNamesArray(i) = FileItem.Name
            FileNameValue = Application.Trim(VBA.Split(FileNamesArray(i))(2))
        
                If tableau(iLig, 0) = FileNameValue Then
                   tableau(iLig, 2) = "TRUE" '.Cells(iLig, 2).Interior.Color = xlNone
                    '.Cells(iLig, 3).Value = "TRUE"
                    Exit For
                Else
                    '.Cells(iLig, 2).Interior.Color = RGB(255, 64, 0)
                    tableau(iLig, 2) = "FALSE"
                End If
         
        Next FileItem
    Next iLig

    Application.ScreenUpdating = True
For y = 2 To dern
    Sheets(1).Cells(y, 3) = tableau(y - 2, 2)
Next
    Set SourceFolder = Nothing
    Set FSO = Nothing

End Sub

essaies de cette facon

il y a peut etre des erreurs , j ai pas tres bien verifié mais potentiellement ca peut aller plus vite dans l idée
B
Black_Hole
Membre fidèle
Membre fidèle
Messages : 191
Inscrit le : 18 juillet 2016
Version d'Excel : 2016 FR

Message par Black_Hole » 26 juin 2019, 18:20

Re @ whereisbryan,

J'ai testé votre macro. Le résultat renvoyé est correcte.

Malheuresement, je suis de nouveau face à une boucle qui ne cesse pas de tourner à partir du moment où le nombre de lignes est supérieur à 1000.

Je ne sais pas comment faire pour permettre à ma macro d'aller plus rapidement?
w
whereisbryan
Membre habitué
Membre habitué
Messages : 145
Inscrit le : 4 janvier 2018
Version d'Excel : 2016 FR

Message par whereisbryan » 27 juin 2019, 09:51

hello @Black_Hole

Je ne vois pas ce qui fait ralentir autant, cela peut tout de meme prendre du temps sur autant d infos donc peut etre attendre meme une 10aine de minutes...

Sinon j ai une autre suggestion: tu devrais passer par la fenêtre des commandes afin d'extraire l intégralité de tes noms de fichiers
mettre tous ces noms sur ta feuille excel dans une nouvelle colonne puis utiliser ta macro pour comparer les 2 colonnes.

Cela va permettre d’éviter d'aller chercher dans un dossier ce qui peut prendre du temps

un lien qui explique comment obtenir le nom de tous tes fichiers: https://www.mediaforma.com/obtenir-la-liste-des-fichiers-dun-dossier-dans-un-fichier-texte/
Répondre Sujet précédentSujet suivant
  • Sujets similaires
    Réponses
    Vues
    Dernier message