Public debphrase
Public ligneretour
Sub deb()
analyse ("UP01")
analyse ("UP02")
analyse ("UP03")
With Sheets("Actual")
Set debfich = .Range("B6")
While debfich.Offset(n, 0) <> ""
If debfich.Offset(n, -1) = "" Then
debfich.Offset(n, -1).Interior.Pattern = xlPatternNone
debfich.Offset(n, -1).Interior.ColorIndex = 5
debfich.Offset(n, -1) = "Deleted"
End If
n = n + 1
Wend
End With
End Sub
Sub analyse(feuille)
With Sheets(feuille)
n = 0
Set debfich = .Range("A6")
While debfich.Offset(n, 0) <> ""
Set debligne = .Range(debfich.Offset(n, 0), debfich.Offset(n, 1))
Set finligne = .Range(debfich.Offset(n, 2), debfich.Offset(n, 42))
r = compare(debligne, finligne)
'MsgBox r & " : " & debphrase & " : " & ligneretour'
Set maligne = .Range(debfich.Offset(n, 0), debfich.Offset(n, 42))
Call ecrit(r, ligneretour, maligne)
n = n + 1
Wend
End With
End Sub
Function compare(debligne, finligne)
debphrase = ""
finphrase = ""
compare = "New"
For Each i In debligne
debphrase = debphrase & i.Value
Next
For Each i In finligne
finphrase = "|" & finphrase & i.Value
Next
Set tableau = New Collection
With Sheets("Actual").Range("b6")
dph = ""
fph = ""
n = 0
While .Offset(n, 0) <> ""
dph = ""
For k = 0 To debligne.Count - 1
dph = dph & .Offset(n, k)
Next
If dph = debphrase Then
Set ligneretour = .Offset(n, 0)
compare = "No change"
For k = debligne.Count To debligne.Count + finligne.Count - 1
fph = "|" & fph & .Offset(n, k)
Next
If fph <> finphrase Then compare = "Modified"
End If
n = n + 1
Wend
End With
End Function
Sub ecrit(r, lg, ligne)
n = 0
Select Case r
Case Is = "Modified"
For Each i In ligne
If lg.Offset(0, n).Value <> i.Value Then lg.Offset(0, n).Interior.ColorIndex = 3 Else lg.Offset(0, n).Interior.ColorIndex = 0
lg.Offset(0, n).Value = i.Value
n = n + 1
lg.Offset(0, -1) = r
Next
Case Is = "No change"
lg.Offset(0, -1) = r
Case Is = "New"
Set dest = lg.Parent.Cells(lg.Columns(2).End(xlDown).Row + 1, 2)
For Each i In ligne
dest.Offset(0, n).Value = i.Value
n = n + 1
dest.Offset(0, -1) = r
dest.Offset(0, n).Interior.ColorIndex = 4
Next
End Select
End Sub