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
|
Dim I, J, K, L, M, N, O As Integer
Dim x, y As Integer
Dim Tableau1(), Tableau2() As String
Dim z, v, w As String
z = " / "
For I = 7 To Sheets.Count 'Boucle sur feuille
For J = 2 To Sheets(I).Range("A65000").End(xlUp).Row
If Sheets(I).Cells(J, 2) = "" Then 'S'il s'agit d'une cellule fusionnée
x = J + 1
Else
y = J
If x <> y Then
For K = x To y
If Sheets(I).Cells(K, 1) = Sheets(I).Cells(K + 1, 1) _
And Sheets(I).Cells(K, 2) = Sheets(I).Cells(K + 1, 2) _
And Sheets(I).Cells(K, 3) = Sheets(I).Cells(K + 1, 3) _
And Sheets(I).Cells(K, 4) = Sheets(I).Cells(K + 1, 4) _
And Sheets(I).Cells(K, 5) = Sheets(I).Cells(K + 1, 5) _
And Sheets(I).Cells(K, 6) = Sheets(I).Cells(K + 1, 6) _
And Sheets(I).Cells(K, 7) = Sheets(I).Cells(K + 1, 7) _
And Sheets(I).Cells(K, 9) = Sheets(I).Cells(K + 1, 9) _
And Sheets(I).Cells(K, 10) = Sheets(I).Cells(K + 1, 10) _
And Sheets(I).Cells(K, 16) = Sheets(I).Cells(K + 1, 16) Then
x = 0
If InStr(Sheets(I).Cells(K, 13), z) <> 0 Then 'Localisation
v = Sheets(I).Cells(K, 13)
w = Sheets(I).Cells(K + 1, 13)
Tableau1 = Split(v, z)
'Boucle sur le tableau pour tester le résultat
For L = 0 To UBound(Tableau1)
If Tableau1(L) = w Then x = 1
Sheets(I).Cells(K, 13) = Sheets(I).Cells(K, 13) & z & Sheets(I).Cells(K + 1, 13)
Next L
If x = 0 Then Sheets(I).Cells(K, 13) = Sheets(I).Cells(K, 13) & z & Sheets(I).Cells(K + 1, 13)
Else
If Sheets(I).Cells(K, 13) <> Sheets(I).Cells(K + 1, 13) Then
Sheets(I).Cells(K, 13) = Sheets(I).Cells(K, 13) & z & Sheets(I).Cells(K + 1, 13)
End If
End If
Rows(K + 1 & ":" & K + 1).Delete Shift:=xlUp
K = K - 1
End If
Next K
End If
End If
Next J
Next I |
Partager