Amelioration de programme

**flooki** · 08/02/2019, 11h43

j'ai reussi a reailiser un macro qui vas comparer deux tableau qui se situe dans deux classeur différent , le macro vas nous donner les différents lignes entre les 2 tabl dans un tableau different . voila les deux tableau et le code que j'ai essai de faire

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
Sub macrocomp()
 
Dim der_lig1 As Integer
der_lig1 = Workbooks("TABLEAU1.xlsm").Sheets(1).Range("A65536").End(xlUp).Row = 6
 
Dim der_lig2 As Integer
der_lig2 = Workbooks("TABLEAU2.xlsm").Sheets(1).Range("A65536").End(xlUp).Row = 6
 
Workbooks("compa.xlsm").Sheets(1).Cells(1, 1) = Workbooks("TABLEAU1.xlsm").Sheets(1).Cells(1, 1).Value
Workbooks("compa.xlsm").Sheets(1).Cells(1, 2) = Workbooks("TABLEAU1.xlsm").Sheets(1).Cells(1, 2).Value
Workbooks("compa.xlsm").Sheets(1).Cells(1, 3) = Workbooks("TABLEAU1.xlsm").Sheets(1).Cells(1, 3).Value
Workbooks("compa.xlsm").Sheets(1).Cells(1, 4) = Workbooks("TABLEAU1.xlsm").Sheets(1).Cells(1, 4).Value
 
Dim der_lig3 As Integer
der_lig3 = 2
 
 
For i = 2 To der_lig2
For j = 2 To der_lig1
If Workbooks("TABLEAU1.xlsm").Sheets(1).Cells(i, 1).Value = Workbooks("TABLEAU2.xlsm").Sheets(1).Cells(j, 1) Then
   For k = 2 To 4
     If Workbooks("TABLEAU1.xlsm").Sheets(1).Cells(i, k).Value <> Workbooks("TABLEAU2.xlsm").Sheets(1).Cells(j, k) Then
         Workbooks("compa.xlsm").Sheets(1).Cells(der_lig3, 1) = Workbooks("TABLEAU2.xlsm").Sheets(1).Cells(j, 1).Value
         Workbooks("compa.xlsm").Sheets(1).Cells(der_lig3, 2) = Workbooks("TABLEAU2.xlsm").Sheets(1).Cells(j, 2).Value
         Workbooks("compa.xlsm").Sheets(1).Cells(der_lig3, 3) = Workbooks("TABLEAU2.xlsm").Sheets(1).Cells(j, 3).Value
         Workbooks("compa.xlsm").Sheets(1).Cells(der_lig3, 4) = Workbooks("TABLEAU2.xlsm").Sheets(1).Cells(j, 4).Value
         der_lig3 = der_lig3 + 1
         Exit For
     End If
   Next
 
End If
Next
Next
 
 
'colorage
 
For i = 2 To der_lig2
For j = 2 To der_lig1
If Workbooks("TABLEAU1.xlsm").Sheets(1).Cells(i, 1).Value = Workbooks("TABLEAU2.xlsm").Sheets(1).Cells(j, 1) Then
   For k = 2 To 4
     If Workbooks("TABLEAU1.xlsm").Sheets(1).Cells(i, k).Value <> Workbooks("TABLEAU2.xlsm").Sheets(1).Cells(j, k) Then
         For l = 2 To der_lig3 - 1
             If Workbooks("TABLEAU1.xlsm").Sheets(1).Cells(i, 1).Value = Workbooks("compa.xlsm").Sheets(1).Cells(l, 1).Value Then
                Workbooks("compa.xlsm").Sheets(1).Cells(l, k).Font.Bold = True
             End If
         Next
     End If
   Next
 
End If
Next
Next
 
End Sub

maintenant je veut que les trois tableau soit dans le méme classeur càd j'ai deja les deux tableaux de donné dans un classeur et je veux afficher le tableau de comparaison dans le meme classeur . si vous avez une idée stp comment adapté mon programme a ce probleme

codialement