Microsoft 365 Comparez deux tables

mlvba84

XLDnaute Nouveau
Salut

Merci de aide
 

Pièces jointes

  • Comparez deux tables1.xlsm
    79.4 KB · Affichages: 24

mlvba84

XLDnaute Nouveau
Private Sub CommandButton2_Click()

Dim c1 As Long, Derlig1 As Long, Derlig2 As Long, Cp As Variant
Dim c2 As Long, fin1, fin2, k1, k2
Set ws1 = Sheets("BOM")
Set ws2 = Sheets("Drawing")
dl1 = ws1.Cells(Rows.Count, 1).End(xlUp).Row
dc1 = ws1.Cells(2, Columns.Count).End(xlToLeft).Column
Application.ScreenUpdating = False
Derlig1 = ws1.Range("A265535").End(xlUp).Row
Derlig2 = ws2.Range("A265535").End(xlUp).Row

rw1 = 2
cl1 = 3

cl2 = 3
rw2 = 2
For cl1 = 3 To dl1

rw1 = 2
rw2 = 2
k1 = ws1.Cells(cl1, rw1)
k2 = ws2.Cells(cl2, rw2)
fix1 = ws1.Cells(cl1, 4)
fix2 = ws2.Cells(cl2, 4)
If k1 = k2 Then
ws1.Cells(cl1, rw1).Interior.ColorIndex = 4 'couleur valeurs similaires
ws2.Cells(cl2, rw2).Interior.ColorIndex = 4
ws1.Cells(cl1, rw1).ClearComments
ws2.Cells(cl1, rw1).ClearComments
ws1.Cells(cl1, rw1).AddComment
temp = ws2.Cells(cl1, rw1).Offset(, 0).Text & " (OK)" & " H" & cl1 & "V" & rw1 & " Drawing"
ws1.Cells(cl1, rw1).Comment.Text Text:=(temp)
ws1.Cells(cl1, rw1).Comment.Shape.TextFrame.AutoSize = True
ws1.Cells(cl1, rw1).Comment.Visible = True
ws2.Cells(cl1, rw1).AddComment
temp = ws1.Cells(cl1, rw1).Offset(, 0).Text & " (OK)" & " H" & cl1 & "V" & rw1 & " BOM"
ws2.Cells(cl1, rw1).Comment.Text Text:=(temp)
ws2.Cells(cl1, rw1).Comment.Shape.TextFrame.AutoSize = True
ws2.Cells(cl1, rw1).Comment.Visible = True


Do While rw1 <= dc1
k1 = ws1.Cells(cl1, rw1)
k2 = ws2.Cells(cl2, rw2)
If k1 = k2 Then
ws1.Cells(cl1, rw1).Interior.ColorIndex = 4 'couleur valeurs similaires
ws2.Cells(cl2, rw2).Interior.ColorIndex = 4

ws1.Cells(cl1, rw1).ClearComments
ws2.Cells(cl1, rw1).ClearComments
ws1.Cells(cl1, rw1).AddComment
temp = ws2.Cells(cl1, rw1).Offset(, 0).Text & " (OK)" & " H" & cl1 & "V" & rw1 & " Drawing"
ws1.Cells(cl1, rw1).Comment.Text Text:=(temp)
ws1.Cells(cl1, rw1).Comment.Shape.TextFrame.AutoSize = True
ws1.Cells(cl1, rw1).Comment.Visible = True
ws2.Cells(cl1, rw1).AddComment
temp = ws1.Cells(cl1, rw1).Offset(, 0).Text & " (OK)" & " H" & cl1 & "V" & rw1 & " BOM"
ws2.Cells(cl1, rw1).Comment.Text Text:=(temp)
ws2.Cells(cl1, rw1).Comment.Shape.TextFrame.AutoSize = True
ws2.Cells(cl1, rw1).Comment.Visible = True
Else
ws1.Cells(cl1, rw1).Interior.ColorIndex = 44
ws1.Cells(cl1, 10) = "Article inexistant dans Base Drawing ou répété plusieurs fois dans Drawing" 'couleur valeurs similaires
ws2.Cells(cl2, rw2).Interior.ColorIndex = 44
ws2.Cells(cl1, 10) = "Article inexistant dans Base BOM ou répété plusieurs fois dans BOM" 'couleur valeurs similaires

ws1.Cells(cl1, rw1).ClearComments
ws2.Cells(cl1, rw1).ClearComments
ws1.Cells(cl1, rw1).AddComment
temp = ws2.Cells(cl1, rw1).Offset(, 0).Text & " (NOK)" & " H" & cl1 & "V" & rw1 & " Drawing"
ws1.Cells(cl1, rw1).Comment.Text Text:=(temp)
ws1.Cells(cl1, rw1).Comment.Shape.TextFrame.AutoSize = True
ws1.Cells(cl1, rw1).Comment.Visible = True
' c.Shape.Fill.ForeColor.SchemeColor = 52
ws2.Cells(cl1, rw1).AddComment
temp = ws1.Cells(cl1, rw1).Offset(, 0).Text & " (NOK)" & " H" & cl1 & "V" & rw1 & " BOM"
ws2.Cells(cl1, rw1).Comment.Text Text:=(temp)
ws2.Cells(cl1, rw1).Comment.Shape.TextFrame.AutoSize = True
ws2.Cells(cl1, rw1).Comment.Visible = True

End If



rw1 = rw1 + 1
rw2 = rw1
Loop
rw1 = 1
rw2 = 1
Else
For cl2 = 4 To dl1
k1 = ws1.Cells(cl1, rw1)
k2 = ws2.Cells(cl2, rw2)
fix1 = ws1.Cells(cl1, 4)
fix2 = ws2.Cells(cl2, 4)
If k1 = k2 Then
' If k1 = k2 Then
ws1.Cells(cl1, rw1).Interior.ColorIndex = 4 'couleur valeurs similaires
ws2.Cells(cl2, rw2).Interior.ColorIndex = 4
Do While rw1 <= dc1
k1 = ws1.Cells(cl1, rw1)
k2 = ws2.Cells(cl2, rw2)
If k1 = k2 Then
ws1.Cells(cl1, rw1).Interior.ColorIndex = 4 'couleur valeurs similaires
ws2.Cells(cl2, rw2).Interior.ColorIndex = 4


ws1.Cells(cl1, rw1).ClearComments
ws2.Cells(cl1, rw1).ClearComments
ws1.Cells(cl1, rw1).AddComment
temp = ws2.Cells(cl1, rw1).Offset(, 0).Text & " (OK)" & " H" & cl1 & "V" & rw1 & " Drawing"
ws1.Cells(cl1, rw1).Comment.Text Text:=(temp)
ws1.Cells(cl1, rw1).Comment.Shape.TextFrame.AutoSize = True
ws1.Cells(cl1, rw1).Comment.Visible = True
ws2.Cells(cl1, rw1).AddComment
temp = ws1.Cells(cl1, rw1).Offset(, 0).Text & " (OK)" & " H" & cl1 & "V" & rw1 & " BOM"
ws2.Cells(cl1, rw1).Comment.Text Text:=(temp)
ws2.Cells(cl1, rw1).Comment.Shape.TextFrame.AutoSize = True
ws2.Cells(cl1, rw1).Comment.Visible = True





Else
ws1.Cells(cl1, rw1).Interior.ColorIndex = 44 'couleur valeurs similaires
ws1.Cells(cl1, 10) = "Article inexistant dans Base Drawing ou répété plusieurs fois dans Drawing" 'couleur valeurs similaires
ws2.Cells(cl2, rw2).Interior.ColorIndex = 44
ws2.Cells(cl1, 10) = "Article inexistant dans Base BOM ou répété plusieurs fois dans BOM" 'couleur valeurs similaires



ws1.Cells(cl1, rw1).ClearComments
ws2.Cells(cl1, rw1).ClearComments
ws1.Cells(cl1, rw1).AddComment
temp = ws2.Cells(cl1, rw1).Offset(, 0).Text & " (NOK)" & " H" & cl1 & "V" & rw1 & " Drawing"
ws1.Cells(cl1, rw1).Comment.Text Text:=(temp)
ws1.Cells(cl1, rw1).Comment.Shape.TextFrame.AutoSize = True
ws1.Cells(cl1, rw1).Comment.Visible = True
ws2.Cells(cl1, rw1).AddComment
temp = ws1.Cells(cl1, rw1).Offset(, 0).Text & " (NOK)" & " H" & cl1 & "V" & rw1 & " BOM"
ws2.Cells(cl1, rw1).Comment.Text Text:=(temp)
ws2.Cells(cl1, rw1).Comment.Shape.TextFrame.AutoSize = True
ws2.Cells(cl1, rw1).Comment.Visible = True
End If
rw1 = rw1 + 1
rw2 = rw1
Loop
rw1 = 2
rw2 = 2

End If
Next cl2



End If
rw1 = 2
rw2 = 2
Next cl1


Application.ScreenUpdating = True
MsgBox ("Controle effectué")

End Sub
 

mlvba84

XLDnaute Nouveau
1603643010723.png
 

Discussions similaires

Réponses
3
Affichages
128
Compte Supprimé 979
C