Microsoft 365 Boucle sur lignes <>0

[eric72]

Bonjour à tous,

j'ai crée une macro pour générer une alerte à l'ouverture de mon fichier, je teste toutes les cellules de ma colonne (x2:x), mais comme il peut y avoir des centaines de lignes cela prend beaucoup de temps d'autant plus qu'il doit chercher la valeur dans une grande plage Feuil4.Range("b2:ss549"), est-il possible de lui demander de tester dans la colonne "x" uniquement si la cellule est différente de 0 ou rien.

Sub alerte()

         Application.ScreenUpdating = False
Dim Cel As Range
Dim Temp
Dim cellulecherchee As Range, ligne As Long, col As Long, valeur_cherchee As String

    
With Sheets("TbCommande")
    For Each Cel In .Range("x2:x" & .Cells(Rows.Count, "a").End(xlUp).Row)
    
    valeur_cherchee = Cel.Offset(, -23).Value
    Set cellulecherchee = Feuil4.Range("b2:ss549").Find(what:=valeur_cherchee, LookIn:=xlValues, lookat:=xlWhole)
    
    
        If Cel.Offset(, 0) <> "" And cellulecherchee Is Nothing Then
                Temp = Temp & vbLf & " M/Me " & Cel.Offset(, -21).Value & " " & "Départ Usine est prévu le " & Cel.Offset(, 0).Value & Chr(13) & Chr(10)
        End If
    Next Cel
    MsgBox "Liste des Chantiers à Planifier:" & Chr(13) & Chr(10) & Temp
End With
Temp = ""

End Sub

Je n'ai pas mis de fichier car je ne pense pas qu'il y en ait besoin, sinon pas de souci demandez moi et je vous mettrais un exemple.
Merci beaucoup pour votre aide.

 

[Franc58]

Bonjour, voici une suggestion. Je place le contenu des feuilles dans des tableaux en mémoire, cela devrait accélérer le traitement.

Sub alerte()
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
    Application.EnableEvents = False

    Dim Temp As String
    Dim data As Variant
    Dim data2 As Variant
    Dim i As Long
    Dim j As Long
    Dim k As Long
    Dim found As Boolean

    With Sheets("TbCommande")
        data = Feuil4.Range("b2:ss549").Value
        data2 = .Range("a2:x" & .Cells(Rows.Count, "a").End(xlUp).Row).Value
        For i = 1 To UBound(data2, 1)
            found = False
            For j = 1 To UBound(data, 1)
                For k = 1 To UBound(data, 2)
                    If data(j, k) = data2(i, 24) Then
                        found = True
                        Exit For
                    End If
                Next k
                If found Then Exit For
            Next j
            If data2(i, 24) <> "" And Not found Then
                Temp = Temp & vbLf & " M/Me " & data2(i, 3) & " " & "Départ Usine est prévu le " & data2(i, 24) & Chr(13) & Chr(10)
            End If
        Next i
        MsgBox "Liste des Chantiers à Planifier:" & Chr(13) & Chr(10) & Temp
    End With

    Application.ScreenUpdating = True
    Application.Calculation = xlCalculationAutomatic
    Application.EnableEvents = True
End Sub

 

[eric72]

Bonjour, voici une suggestion. Je place le contenu des feuilles dans des tableaux en mémoire, cela devrait accélérer le traitement.

Sub alerte()
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
    Application.EnableEvents = False

    Dim Temp As String
    Dim data As Variant
    Dim data2 As Variant
    Dim i As Long
    Dim j As Long
    Dim k As Long
    Dim found As Boolean

    With Sheets("TbCommande")
        data = Feuil4.Range("b2:ss549").Value
        data2 = .Range("a2:x" & .Cells(Rows.Count, "a").End(xlUp).Row).Value
        For i = 1 To UBound(data2, 1)
            found = False
            For j = 1 To UBound(data, 1)
                For k = 1 To UBound(data, 2)
                    If data(j, k) = data2(i, 24) Then
                        found = True
                        Exit For
                    End If
                Next k
                If found Then Exit For
            Next j
            If data2(i, 24) <> "" And Not found Then
                Temp = Temp & vbLf & " M/Me " & data2(i, 3) & " " & "Départ Usine est prévu le " & data2(i, 24) & Chr(13) & Chr(10)
            End If
        Next i
        MsgBox "Liste des Chantiers à Planifier:" & Chr(13) & Chr(10) & Temp
    End With

    Application.ScreenUpdating = True
    Application.Calculation = xlCalculationAutomatic
    Application.EnableEvents = True
End Sub

Bonjour Franc58,
Tout d'abord merci pour ta réponse, pour imager je t'ai confié une 2cv de 1963, et je viens de récupérer une formule 1, en effet cela n'a rien à voir.
Merci 1000 fois pour ta disponibilité et bonne soirée.
Eric