Recherche et Validation des données

Bonjour à tous,

Je dois crée une macro de véricification des données sur un vieux fichier de 15000 lignes...

Je vous joint un fichier exemple.

En gros je dois regarder regarder pour chaque N° de CAD.

Dans la feuille 1 j'ai les données qui sont bonne et en feuille 2 j'ai un tableau (normalement plus horrible) Et je dois vérifier que les données de chaque ligne de la feuille 1 soit présente dans la feuille 2.

JE suis un peux en galère et la fonction Find n'est pas mon fort !! mais je suis entrain d'essayer avec d'autre technique. Je regarde de mon coté.

Merci d'avance

Salut

Voilà ma V1 de code :

Public Sub Validation_Data()

Dim L As Long
Dim P As Long
Dim L2 As Long

Dim a, a2, a3, a4, a1, a5, a6, a7, a8, a9, a10, a11 As String
Dim b, b1, b2, b4, b3, b5, b6, b7, b8, b9, b10, b11 As String

Dim d As Boolean
Dim d2 As Boolean
Dim C1, C2 As CellFormat

d = False
d2 = False

For L = 2 To 500

Sheets("Donnée en forme").Activate

    ' CAD number
    a = Cells(L, 1)

    ' Ancien PPNR
    a1 = Cells(L, 2)

    'Rev Ancien PNR
    a2 = Cells(L, 3)

    ' Ancien PNR sans REV
    a4 = Cells(L, 4)

    'PNR actu
    a5 = Cells(L, 7)

    'REv new PNR
    a6 = Cells(L, 8)

    'NEW PNR sans rev
    a7 = Cells(L, 9)

    'Description
    a8 = Cells(L, 10)

    ' IC
    a9 = Cells(L, 11)

    'Qty
    a10 = Cells(L, 12)

    'PNR parent
    a11 = Cells(L, 14)

    Worksheets("SBOM").Activate

For P = 2 To 13674

    b = Cells(P, 13)
    b4 = Cells(P, 1)
    b2 = Cells(P, 2)
    b5 = Cells(P, 5)
    b6 = Cells(P, 4)
    b7 = Cells(P, 6)
    b8 = Cells(P, 10)
    b9 = Cells(P, 7)
    b10 = Cells(P, 11)
    b11 = Cells(P, 8)

    If a = b Then
    d = True

     If a2 = b2 And b4 = a4 And b5 = a5 And b6 = a6 And b7 = a7 And b8 = a8 And b9 = a9 And b10 = a10 And b11 = a11 Then
     d2 = True
     End If

    End If

Next P

    If d2 = False Then
    Sheets("Donnée en forme").Activate

    Rows(L).Select
    Sheets("Erreur").Select
    Selection.Copy

    L2 = Range("A50000").End(xlUp).Row + 1
      Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False

    End If

    If d = False Then
    MsgBox ("CAD number absent")
    Exit For

    End If

Next L

End Sub

Sauf que j'ai un petite soucis d'exécution, lorsque il trouve une ligne juste, il m'envoie une erreur d'exécution de type 13.

bonjour,

solution via une macro, (attention : la macro modifie la feuil2 (tri et remplacement des formules en colonne K, par leur valeur)), j'ai supposé que ce n'était pas un contrainte que de garder cette feuille intacte)

Sub aargh()
    Set ws1 = Sheets("feuil1")
    Set ws2 = Sheets("feuil2")
    dlws1 = ws1.Cells(Rows.Count, 1).End(xlUp).Row ' dernière ligne ws1
    dlws2 = ws2.Cells(Rows.Count, 1).End(xlUp).Row ' dernière ligne ws2
    With ws2.Range("K1:K" & dlws2)
        .Copy
        .PasteSpecial Paste:=xlPasteValues ' éliminer formule de la colonne K
    End With
    With ws2.Range("A1:K" & dlws2) ' tri de ws2 sur colonne 1 & 2
        .Sort key1:=ws2.Range("A1"), order1:=xlAscending, key2:=ws2.Range("B1"), order2:=xlAscending, Header:=xlYes
        With .Interior ' suppression des couleurs sur ws2
            .Pattern = xlNone
            .TintAndShade = 0
            .PatternTintAndShade = 0
        End With
    End With
    For i = 2 To dlws1 'pour chaque ligne de ws1
        Set re = ws2.Range("A1:A" & dlws2).Find(ws1.Cells(i, 1), lookat:=xlWhole) 'on cherche le cad sur ws2
        If Not re Is Nothing Then 'si trouvé
            j = re.Row 'j 1ère ligne de ws2 avec la même CAD
            Do While ws2.Cells(j, 1) = ws1.Cells(i, 1) 'tant que même cad
                If ws1.Cells(i, 2) = ws2.Cells(j, 2) Then 'même ancien PNR ?
                    For k = 3 To 11 'oui, on compare le contenu des différentes colonnes de ws1 et ws2
                        If ws1.Cells(i, k) <> ws2.Cells(j, k) Then ws2.Cells(j, k).Interior.Color = vbRed
                    Next k
                    Exit Do 'on a fini le traitement de ligne de ws1 on passe à la suivante
                Else
                ' on n'a pas trouvé la ligne dans ws2, on met la ligne de ws1 en rouge et on passe à la ligne suivante de ws1
                    If ws1.Cells(i, 2) < ws2.Cells(j, 2) Then ws1.Range("A" & i & ":K" & i).Interior.Color = vbRed: Exit Do
                End If
                j = j + 1 ' on passe à la ligne suivante de ws2
            Loop
        Else
            ws1.Range("A" & i & ":K" & i).Interior.Color = vbRed ' code CAD non trouvé sur ws2, on met la ligne de ws1 en rouge et on passe à la ligne suivante de ws1
        End If
    Next i
End Sub

Merci.

je vais tester ça en modifiant.

En faite je ne doit surtout pas modifier la feuille deux. je dois juste renvoyé les lignes qui sont en erreur ou non présenté de la feuille 1 dans un 3 ème onglet

mais je vais regarder ça