Macro Recherche

Sub Analyse()
'
' Analyse Macro
'
Dim nbl As Integer
Dim Cle As String
Dim Mt As Integer

With ActiveSheet
     nbl = .Range("A" & .Rows.Count).End(xlUp).Row - 1
   
    For i = 2 To nbl
        .Range("P" & i) = nbl 'copie du nombre de lignes en Pi
        .Range("N" & i) = .Range("D" & i) & .Range("F" & i) & .Range("O" & i) 'création de la clé avec les cellules colonne D F et O
     Next i
   
End With


End Sub

Sub Analyse()
'
' Analyse Macro
'
Dim nbl As Integer
Dim Cle As String
Dim Mt As Integer

Dim TabEcritures() As Variant 'déclare un tablo VBA

With ActiveSheet 'dans la feuille active (Ecritures)
    nbl = .Range("A" & .Rows.Count).End(xlUp).Row - 1 'récupère le nombre de lignes de la feuille
    TabEcritures = .Range("A2:N" & nbl).Value 'on met tout le tableau (+1 colonne) dans le tablo VBA
   
    For i = LBound(TabEcritures, 1) To UBound(TabEcritures, 1) - 1 'pour chaque ligne du tableau
        clé = TabEcritures(i, 4) & TabEcritures(i, 6) & Int(100 * (TabEcritures(i, 7) + TabEcritures(i, 8))) 'on crée la clé
        For j = i + 1 To UBound(TabEcritures, 1) 'pour toutes les lignes suivantes
            If TabEcritures(j, 4) & TabEcritures(j, 6) & Int(100 * (TabEcritures(j, 7) + TabEcritures(j, 8))) = clé Then 'si on retrouve la meme clé
                TabEcritures(j, UBound(TabEcritures, 2)) = "Trouvé" 'on écrit "trouvé" dans la dernière colone du tablo VBA
                TabEcritures(i, UBound(TabEcritures, 2)) = "Trouvé"
            End If
        Next j
    Next i
End With

With Sheets("Résultats") 'dans la feuille résultat
    .UsedRange.Offset(1, 0).Delete 'j'efface tout sauf la ligne d'entete
    .Range("A2").Resize(UBound(TabEcritures, 1), UBound(TabEcritures, 2)) = TabEcritures 'on colle tout le tablo VBA dans la feuille
    .Range("A1").Resize(UBound(TabEcritures, 1), UBound(TabEcritures, 2)).AutoFilter Field:=14, Criteria1:="<>" 'on filtre la dernière colonne avec "trouvé"
    Application.DisplayAlerts = False 'on désactive les messages utilisateur
    .Range("A2").Resize(UBound(TabEcritures, 1), UBound(TabEcritures, 2)).SpecialCells(xlCellTypeVisible).Delete 'on supprime les lignes "trouvé"
    Application.DisplayAlerts = True 'on reactive les mesage
    .Range("A1").Resize(UBound(TabEcritures, 1), UBound(TabEcritures, 2)).AutoFilter 'on enlève le filtre
End With

End Sub