Option Explicit
Option Base 1
Sub Comparatif_Release()
Dim t1, t2, c, c2, temp, temp2
Dim d(1 To 8) As Object
Dim i&, j&, l&, l2&
Dim f As Worksheet
'On place les données dans deux tableaux.
Set f = Sheets("Sheet1")
With f
l = .Cells.Find("*", , , , xlByRows, xlPrevious).Row
t1 = .Range("a3:e" & l).Value
t2 = .Range("g3:k" & l).Value
End With
'Nous créons les dictionnaires.
For i = 1 To 8
Set d(i) = CreateObject("Scripting.Dictionary")
Next i
'Nous réalisons un index par communauté.
For i = LBound(t1) To UBound(t1)
d(1)(t1(i, 1) & ":" & t1(i, 2)) = d(1)(t1(i, 1) & ":" & t1(i, 2)) & i & ":"
d(2)(t2(i, 1) & ":" & t2(i, 2)) = d(2)(t2(i, 1) & ":" & t2(i, 2)) & i & ":"
Next i
'Nous vérifions si les communautés existent dans les deux dictionnaires.
'S'il n'existe pas dans d(2), c'est une suppression
For Each c In d(1).Keys
If Not d(2).exists(c) Then
d(4)(c) = d(1)(c)
Else: d(3)(c) = ""
End If
Next c
'S'il n'existe pas dans d(1), c'est un ajout
For Each c In d(2).Keys
If Not d(1).exists(c) Then
d(5)(c) = d(2)(c)
Else: d(3)(c) = ""
End If
Next c
'Nous allons commencer à extraire les valeurs.
j = 3
'On extrait les communautés supprimées.
For Each c In d(4)
'Nous créons un tableau temporaire, reprenant les lignes à analyser.
temp = Split(d(1)(c), ":")
d(6)(t1(temp(0), 1) & ":" & t1(temp(0), 1) & ":" & "Deleted Community") = d(6)(t1(temp(0), 1) & ":" & t1(temp(0), 1) & ":" & "Deleted Community") & "Old Rank :" & t1(temp(0), 5)
For i = LBound(temp) To UBound(temp) - 1
Debug.Print t1(temp(i), 1)
l = temp(i)
d(6)(t1(l, 1) & ":" & t1(l, 1) & ":" & "Deleted Community") = d(6)(t1(l, 1) & ":" & t1(l, 1) & ":" & "Deleted Community") & Chr(10) & "Old Features :" & t1(l, 3)
Next i
Next c
'On extrait les communautés supprimées.
For Each c In d(5)
'Nous créons un tableau temporaire, reprenant les lignes à analyser.
temp = Split(d(2)(c), ":")
d(6)(t2(temp(0), 1) & ":" & t2(temp(0), 1) & ":" & "New Community") = d(6)(t2(temp(0), 1) & ":" & t2(temp(0), 1) & ":" & "New Community") & "New Rank :" & t2(temp(0), 5)
For i = LBound(temp) To UBound(temp) - 1
Debug.Print t2(temp(i), 1)
l = temp(i)
d(6)(t2(l, 1) & ":" & t2(l, 1) & ":" & "New Community") = d(6)(t2(l, 1) & ":" & t2(l, 1) & ":" & "New Community") & Chr(10) & "Old Features :" & t2(l, 3)
Next i
Next c
'On va comparer les communautés encore présentes.
'Nous allons créer deux tableaux pour reprendre les valeurs à comparer.
'1ère étape, nous enregistrons les lignes à analyser.
For Each c In d(3).Keys
temp = Split(d(1)(c), ":")
temp2 = Split(d(2)(c), ":")
'Nous comparons les rangs.
If t1(temp(0), 5) <> t2(temp2(0), 5) Then d(6)(t1(temp(0), 1) & ":" & t1(temp(0), 2) & ":" & "Rank") = "Old Rank :" & t1(temp(0), 5) & ", New Rank :" & t2(temp2(0), 5) & " Change percentage : " & Round((t2(temp2(0), 4) / t1(temp(0), 4) - 1) * 100, 2) & "%"
'Nous ajoutons tous les features des deux tableaux.
For i = LBound(temp) To UBound(temp) - 1
l = temp(i)
d(7)(t1(l, 3)) = ""
Next i
For i = LBound(temp2) To UBound(temp2) - 1
l2 = temp2(i)
d(8)(t2(l2, 3)) = ""
Next i
For Each c2 In d(7).Keys
If Not d(8).exists(c2) Then d(6)(c & ":" & "Features deleted") = d(6)(c & ":" & "Features deleted") & c2 & ", "
Next c2
For Each c2 In d(8).Keys
If Not d(7).exists(c2) Then d(6)(c & ":" & "Features added") = d(6)(c & ":" & "Features added") & c2 & ", "
Next c2
Next c
'On ajoute les valeurs à la feuille.
For Each c In d(6)
Cells(j, "N").Resize(, 3).Value = Split(c, ":")
Cells(j, "Q").Value = d(6)(c)
j = j + 1
Next c
End Sub
