[VB] Comparer 2 colonnes et extraire ligne inexistante

Comparer 2 colonnes et extraire ligne inexistante [VB] - VB/VBA/VBS - Programmation

Marsh Posté le 05-08-2012 à 19:18:03    

Hello,
 
Je me suis mis depuis peu au VB et je galère pour une chose hyper facile à comprendre mais difficile à coder.
Je veux comparer 2 colonnes de 2 sheets différentes et extraire dans une 3eme sheets, si je ne retrouve pas la ligne de la sheet 1 dans la sheet 2 (uniquement).
 
Je pars d'une boucle principale (i,j) et dès que je trouve un résultat équivalent, j'entre dans une deuxième boucle (i,k) pour voir si les lignes suivantes sont équivalentes ou pas.
 
Le programme commence bien et après ce dégénère et je pige pas le problème.
 
Le code (la fonction de tri marche bien par contre):
 
 
Sub comparaison_data()
 
i = 2
j = 2
k = 2
v = 2
Count = 0
count2 = 0
find_diff = 0
 
Sheets("comparaison_data" ).Select
Cells.Select
Selection.ClearContents
 
    While (Sheets("new_data" ).Cells(i, 3).Value <> "" )
 
        If (Sheets("new_data" ).Cells(i, 3).Value < Sheets("old_data" ).Cells(j, 3).Value) Then
            i = i + 1
         
         
         
        ElseIf (Sheets("new_data" ).Cells(i, 3).Value > Sheets("old_data" ).Cells(j, 3).Value) Then
            j = j + 1
            count2 = 0
            'k = j
     
        ElseIf (Sheets("new_data" ).Cells(i, 3).Value = Sheets("old_data" ).Cells(j, 3).Value) Then
         
            k = j + count2
             
             
            While (Sheets("new_data" ).Cells(i, 3).Value = Sheets("old_data" ).Cells(k, 3).Value And find_diff = 0)
                 
                 
                If (Sheets("new_data" ).Cells(i, 7).Value = Sheets("old_data" ).Cells(k, 7).Value) Then
                    k = k + 1
                    Count = Count + 1
                    'find_diff = 0
                    no_diff = 1
                 
                ElseIf (no_diff = 0 And Sheets("new_data" ).Cells(i, 7).Value <> Sheets("old_data" ).Cells(k - Count, 7).Value) Then
                    Sheets("comparaison_data" ).Rows(v).Value = Sheets("new_data" ).Rows(i).Value
                    k = k + 1
                    v = v + 1 'pour écrire à la suite de la feuilel de comparaison
                    Count = 0
                    find_diff = 1
                    Count = Count + 1
                     
                 
                Else
                    k = k + 1
                    Count = Count + 1
                     
                End If
                 
            Wend
            i = i + 1
            Count = 0
            count2 = count2 + 1
            Count_diff = 0
            find_diff = 0
            no_diff = 0
     
        End If
         
         
         
    Wend
End Sub
 
 
 
Private Sub tri_sheet(atrier As Worksheet, cle_de_tri_1 As Byte, Optional cle_de_tri_2 As Byte = 0, Optional cle_de_tri_3 As Byte = 0, Optional cle_de_tri_4 As Byte = 0)
 
    atrier.Sort.SortFields. _
    Clear
    atrier.Sort.SortFields. _
        Add Key:=atrier.Columns(cle_de_tri_1), SortOn:=xlSortOnValues, Order:=xlAscending, _
        DataOption:=xlSortNormal
     
    If (cle_de_tri_2 > 0) Then
        atrier.Sort.SortFields. _
            Add Key:=atrier.Columns(cle_de_tri_2), SortOn:=xlSortOnValues, Order:=xlAscending, _
            DataOption:=xlSortNormal
    End If
     
    If (cle_de_tri_3 > 0) Then
        atrier.Sort.SortFields. _
            Add Key:=atrier.Columns(cle_de_tri_3), SortOn:=xlSortOnValues, Order:=xlAscending, _
            DataOption:=xlSortNormal
    End If
    If (cle_de_tri_4 > 0) Then
        atrier.Sort.SortFields. _
            Add Key:=atrier.Columns(cle_de_tri_4), SortOn:=xlSortOnValues, Order:=xlAscending, _
            DataOption:=xlSortNormal
    End If
     
    With atrier.Sort
        .SetRange atrier.UsedRange
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
 
End Sub
 
 
Sub init()
Call tri_sheet(Sheets("new_data" ), 3, 7, 8)
Call tri_sheet(Sheets("old_data" ), 3, 7, 8)
 
End Sub

Reply

Marsh Posté le 05-08-2012 à 19:18:03   

Reply

Marsh Posté le 05-08-2012 à 19:19:09    

Il y a peut-être une fonction qui fait çà directement sur VB mais je n'ai pas trouvé...
je peux envoyer également le fichier excel

Reply

Sujets relatifs:

Leave a Replay

Make sure you enter the(*)required information where indicate.HTML code is not allowed