Option Explicit

'**********************************_______________****************************************

'   Tel que je l'ai compris à travers ton code initial, il s'agit de compter le nombre de
    'valeurs construites à partir d'une liste qui ne se trouveraient pas dans une autre.
    'Je me pose la question: pourquoi construire ? Ces valeurs n'éxisteraient-elles pas
    'déjà quelque part ?
    
    'Il est toujours bon de mettre sur la pile un programme léger. J'ai donc détaché
    'certaines instructions dans des fonctions séparées. Ceraines instructions de
    'décisions ont été remplacés par des opérations arithmétiques pour une affectation directe.
    
    'Application.Machin est très lourd pour ce genre de traitement.
    'Pour quelqu'un qui se donne encore la peine, un autre schéma beaucoup plus efficace est possible.
    
    'NB : Je suis sur une machine qui me fait de ces grimaces.
    
Function NoScrute(valeur, table) As Long
'   NoScrute = IsError(Application.Match(valeur, table, 0)) 'sera plus long de même que: _
   NoScrute = IsError(Application.VlookUp(valeur, table, 1, false) _
   commenter celle du dessous et décommenter l'une des dessus pour s'en apercevoir.

    Dim l As Long, n As Long

    n = UBound(table)

    Do
        l = l + 1
        If table(l, 1) = valeur Then l = n + 1: Exit Do
    Loop Until l = n

    NoScrute = (l = n)
    
End Function

Function cntTest(ref) As Long
        
        If Feuil1.Cells(ref, 2) >= 6500 And Feuil1.Cells(ref, 2) <= 6720 Then
            cntTest = 13
        Else
            cntTest = 20
        End If
        
End Function

Sub TestCalculOut_B()
    Dim I As Long, J As Long, nbLignes As Long, LigneOut As Long
    Dim Cnt As Long, CntMax As Long, tour As Long
    Dim valeur
    Dim Temps As Double
    
    Dim liste, ref 'les plage de comparaisons et de references
    Dim result() As Long ' contiendra les résultats destinés à AX1:AX...
    
    Temps = Timer
    
    With Application
        .Interactive = False
        .ScreenUpdating = False
        .Calculation = xlCalculationManual
    End With
    
    nbLignes = Sheets("SFF").Cells(Rows.Count, "B").End(xlUp).Row
    LigneOut = Sheets("Suivi OUT").Cells(Rows.Count, "B").End(xlUp).Row
    
    liste = Sheets("Suivi OUT").Range("B2:B" & LigneOut)
    ref = Sheets("SFF").Range("A5:A" & nbLignes)
    ReDim result(1 To nbLignes - 4, 1 To 1)
    
    For I = 1 To nbLignes - 4
        Cnt = 0
        CntMax = cntTest(I)
        For J = CntMax To 1 Step -1
            valeur = ref(I, 1) & J
            result(I, 1) = result(I, 1) + NoScrute(valeur, liste)
            tour = tour + 1
        Next
        result(I, 1) = Abs(result(I, 1))
    Next
    
    Sheets("SFF").Range("AX5:AX" & nbLignes).Value = result
    
    With Application
        .ScreenUpdating = True
        .Interactive = True
        .Calculation = xlCalculationAutomatic
    End With
    
    Debug.Print "Terminé en" & vbCrLf & Timer - Temps & " sec."
    
    
End Sub


Sub activer()
    With Application
        .ScreenUpdating = True
        .Interactive = True
        .Calculation = xlCalculationAutomatic
    End With

End Sub