Sub test()
' Semaine - 1 (V010115)
Dim Fsmoin1 As Worksheet
Set Fsmoin1 = Worksheets("V010115")
Dim TabFsmoin1() As Variant
TabFsmoin1 = Fsmoin1.Range(Fsmoin1.Cells(2, 1), Fsmoin1.Cells(7, 39))
' Semaine en cours (V140115)
Dim Fs As Worksheet
Set Fs = Worksheets("V140115")
Dim TabFs() As Variant
TabFs = Fs.Range(Fs.Cells(2, 1), Fs.Cells(7, 39))
' Creation d'un Nouveau tableau regroupant les 2
Dim TabRes() As Variant
ReDim TabRes(1 To UBound(TabFsmoin1, 1) + UBound(TabFs, 1), 1 To 42)
Dim cpt, i As Integer
cpt = 0
' Semaine - 1 (V010115)
For i = 1 To UBound(TabFsmoin1, 1)
'For j = 1 To UBound(TabFsmoin1, 2)
TabRes(i, 1) = Fsmoin1.Name
TabRes(i, 3) = TabFsmoin1(i, 3)
TabRes(i, 4) = TabFsmoin1(i, 4)
TabRes(i, 39) = TabFsmoin1(i, 39)
'Next j
For j = 1 To UBound(TabFsmoin1, 2)
If j <> 1 And j <> 3 And j <> 4 And j <> 39 Then
TabRes(i, j) = TabFsmoin1(i, j)
End If
Next
Next i
' Semaine en cours (V140115)
For i = UBound(TabFs, 1) + 1 To UBound(TabRes, 1)
'For j = 1 To UBound(TabFs, 2)
TabRes(i, 1) = Fs.Name
TabRes(i, 3) = TabFs(i - UBound(TabFs, 1), 3)
TabRes(i, 4) = TabFs(i - UBound(TabFs, 1), 4)
TabRes(i, 39) = TabFs(i - UBound(TabFs, 1), 39)
'Next j
For j = 1 To UBound(TabFs, 2)
If j <> 1 And j <> 3 And j <> 4 And j <> 39 Then
TabRes(i, j) = TabFs(i - UBound(TabFs, 1), j)
End If
Next
Next i
' Les conditions (Doublon pour identique)
For i = 1 To UBound(TabRes, 1)
For j = i + 1 To UBound(TabRes, 1)
If TabRes(i, 3) & TabRes(i, 39) = TabRes(j, 3) & TabRes(j, 39) Then
TabRes(j, 42) = "Identique"
End If
Next j
Next i
'Cells(23, 1).Resize(UBound(TabRes, 1), UBound(TabRes, 2)) = TabRes
' Les conditions (Difference)
For i = 1 To UBound(TabRes, 1)
For j = i + 1 To UBound(TabRes, 1)
If TabRes(i, 3) = TabRes(j, 3) And TabRes(i, 39) <> TabRes(j, 39) Then
TabRes(j, 42) = "Modifier"
End If
Next j
Next i
'Cells(23, 1).Resize(UBound(TabRes, 1), UBound(TabRes, 2)) = TabRes
' Les conditions (suprimer)
For i = 1 To UBound(TabRes, 1)
If TabRes(i, 1) = Fsmoin1.Name And TabRes(i, 42) = "" Then
For j = i + 1 To UBound(TabRes, 1)
If TabRes(i, 3) = TabRes(j, 3) Then
TabRes(i, 41) = "suprimer Doublon !"
End If
Next j
If TabRes(i, 41) = "suprimer Doublon !" Then
TabRes(i, 42) = "suprimer Doublon !"
Else
TabRes(i, 42) = "suprimer"
End If
End If
Next i
'Cells(23, 1).Resize(UBound(TabRes, 1), UBound(TabRes, 2)) = TabRes
' Les conditions (crée)
For i = 1 To UBound(TabRes, 1)
If TabRes(i, 1) = Fs.Name And TabRes(i, 42) = "" Then
TabRes(i, 42) = "crée"
End If
Next i
'Cells(23, 1).Resize(UBound(TabRes, 1), UBound(TabRes, 2)) = TabRes
' colle les données dans le tableau
For i = 1 To UBound(TabRes, 1)
If TabRes(i, 42) <> "suprimer Doublon !" And TabRes(i, 42) <> "Identique" Then
cpt = cpt + 1
End If
Next i
' Tableau restitution final annalyse
' Creation d'un Nouveau tableau regroupant les 2
Dim TabFinal() As Variant
ReDim TabFinal(1 To 12, 1 To 39)
cpt = 1
' colle les données dans le tableau
For i = 1 To UBound(TabRes, 1)
If TabRes(i, 42) = "suprimer" Or TabRes(i, 42) = "Modifier" Or TabRes(i, 42) = "crée" Then
TabFinal(cpt, 3) = TabRes(i, 3)
TabFinal(cpt, 4) = TabRes(i, 4)
TabFinal(cpt, 39) = TabRes(i, 39)
TabFinal(cpt, 1) = TabRes(i, 42)
For j = 1 To UBound(TabRes, 2) - 3
If j <> 1 And j <> 3 And j <> 4 And j <> 39 Then
TabFinal(cpt, j) = TabRes(i, j)
End If
Next
cpt = cpt + 1
End If
Next i
Cells(2, 1).Resize(UBound(TabFinal, 1), UBound(TabFinal, 2)) = TabFinal
End Sub