Optimisation Code

Private Declare Function QueryPerformanceCounter Lib "Kernel32" (X As Currency) As Boolean
Private Declare Function QueryPerformanceFrequency Lib "Kernel32" (X As Currency) As Boolean
Option Explicit
 
Sub GestionDuTout()

Dim Debut As Currency, Fin As Currency, Freq As Currency
QueryPerformanceCounter Debut


    Sheets("Feuil4").Cells.ClearContents
    Sheets("Feuil5").Cells.ClearContents
    'selection.ClearContents
    
    'MsgBox ("Suppression effectué")


'GESTION DES DOUBLONS ET MISE EN PLACE DES IDENTIFIANTS



    Dim TableauDestination() As String, TableauIdentifiant() As String, TableauValeurIdentifiant() As String, TableauValeurSource() As String, TableauTargetSource() As String
    Dim TableauIdSource() As String, TableauIdentifiantTarget() As String, TableauDestinationTarget() As String, CompteurLigneDif() As String
    Dim derniere_ligne As Long, derniere_ligne2 As Long, derniere_colonne As Long, Comparateur6 As String, Comparateur5 As String, ComparateurInstituts1 As String, ComparateurInstituts2 As String, derniere_ligne3 As Long
    Dim Verification  As Boolean, Verification2 As Boolean, Verification3 As Boolean, Verif As Boolean
    
    Dim Comparateur1 As String, Comparateur2 As String, Comparateur3  As String, Comparateur4 As String, Test As String
    Dim j As Long, i As Long, w As Long, n As Long, u As Long, b As Long, h As Long, t As Long
    Dim k As Long, l As Long, m As Long, a As Long, o As Long, f As Long, ComparNum2 As Long, ComparNum1 As Long
    a = 1
    n = 1
    k = 1
    o = 1
    f = 1
    h = 1
    w = 2
    
    
    
    derniere_ligne = Sheets("Feuil2").Range("A1").End(xlDown).Row
    derniere_colonne = Sheets("Feuil3").Range("H3").End(xlDown).Row
    

    Dim Ws_Feuille_comparaison As Worksheet
    Set Ws_Feuille_comparaison = ThisWorkbook.Worksheets("Feuil3")
    
    Dim Ws_Feuille_destination As Worksheet
    Set Ws_Feuille_destination = ThisWorkbook.Worksheets("Feuil2")
    
    Dim Ws_feuille_Gephi As Worksheet
    Set Ws_feuille_Gephi = ThisWorkbook.Worksheets("Resultats")
    
    Dim Ws_Feuille_Identifiant As Worksheet
    Set Ws_Feuille_Identifiant = ThisWorkbook.Worksheets("Feuil4")
    
    Dim Ws_Feuille_Source As Worksheet
    Set Ws_Feuille_Source = ThisWorkbook.Worksheets("Feuil5")
    

    
'On va entrer les instituts que l'on étudie au début du tableau. Cela nous permettra de gérer plus facilement les
'target par la suite

    Ws_Feuille_Identifiant.Cells(1, 1) = "Id"
    Ws_Feuille_Identifiant.Cells(1, 2) = "Label"
    Ws_Feuille_Source.Cells(1, 1) = "Source"
    Ws_Feuille_Source.Cells(1, 2) = "Target"
    Ws_Feuille_Source.Cells(1, 3) = "Weight"


For i = 2 To derniere_colonne - 1
    Ws_Feuille_Identifiant.Cells(i, 2) = Ws_Feuille_comparaison.Cells(i + 1, 7) + ", " + Ws_Feuille_comparaison.Cells(i + 1, 8)
    Ws_Feuille_Identifiant.Cells(i, 1) = i
Next

derniere_ligne3 = Sheets("Feuil4").Range("A1").End(xlDown).Row





'-----------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------

                                                'GESTION DES TARGETS
                                                
derniere_ligne3 = derniere_colonne + 1




'Essaie


derniere_ligne = 17710

'Création des tableaux dynamique virtuelle pour gagner du temps dans le traitement


ReDim TableauIdentifiant(derniere_ligne)
ReDim TableauDestination(derniere_ligne)
ReDim TableauValeurIdentifiant(derniere_ligne)
ReDim TableauDestinationTarget(derniere_ligne)

For i = 1 To derniere_ligne
    TableauDestination(i) = Ws_Feuille_destination.Cells(i, 6)
    TableauDestinationTarget(i) = Ws_Feuille_destination.Cells(i, 7) '
Next
    
For i = 1 To derniere_ligne
    TableauValeurIdentifiant(i) = Ws_Feuille_Identifiant.Cells(i + 1, 1)
    TableauIdentifiant(i) = Ws_Feuille_Identifiant.Cells(i + 1, 2)
Next


'Premiere partie de code permettant de gérer les doublons.

'MsgBox (derniere_ligne3)
For j = 1 To derniere_ligne   'Va chercher l'instituts a transferer vers la colonne sans doublon
    Verification = True
    For i = 1 To derniere_ligne3    'Regarde si il n'y a pas de doublon déjà présent
    'MsgBox ("j = " & j & " Comparant : " & LCase(TableauDestination(j)) & "        " & "Comparer : " & LCase(TableauIdentifiant(i)))
        If LCase(TableauIdentifiant(i)) = LCase(TableauDestination(j)) And Verification = True Then
            Verification = False
        ElseIf LCase(TableauIdentifiant(i)) = "" And Verification = True Then
            TableauIdentifiant(i) = TableauDestination(j)
            TableauValeurIdentifiant(i) = i
            derniere_ligne3 = derniere_ligne3 + 1
            Verification = False
            'MsgBox (TableauIdentifiant(i))
        End If
    Next
Next

Application.ScreenUpdating = False
For i = derniere_colonne To derniere_ligne3
    Ws_Feuille_Identifiant.Cells(i, 1) = TableauValeurIdentifiant(i)
    Ws_Feuille_Identifiant.Cells(i, 2) = TableauIdentifiant(i)
Next
Application.ScreenUpdating = True
'Partie permettant de gérer les targets ainsi que les poids de chaques instituts en fonction de leur targets
 
 l = 1
 
 
 ReDim TableauValeurSource(derniere_ligne)
 ReDim TableauTargetSource(derniere_ligne)
 ReDim TableauIdSource(derniere_ligne)
 
 
For i = 1 To derniere_ligne
    TableauTargetSource(i) = ""
    TableauValeurSource(i) = ""
    TableauIdSource(i) = ""
Next

   n = 1
   l = 1

For i = 1 To derniere_ligne3 - 1

    Verification = True
    Verification2 = True
        TableauIdSource(k) = TableauIdentifiant(i)
'        MsgBox (TableauIdSource(k))
        For j = 1 To derniere_ligne
'            Verification2 = True
            'MsgBox ("Instituts Comparer : " & Ws_Feuille_Identifiant.Cells(i, 1) & " Instituts comparant : " & Ws_Feuille_destination.Cells(j, 6))
            If LCase(TableauIdentifiant(i)) = LCase(TableauDestination(j)) Then
                If TableauTargetSource(k) = "" And Verification = True Then

                    TableauTargetSource(k) = TableauDestinationTarget(j)
                    TableauValeurSource(k) = 1
                    
                ElseIf LCase(TableauTargetSource(k)) = LCase(TableauDestinationTarget(j)) Then
                    h = TableauValeurSource(k)
                    h = h + 1
                    TableauValeurSource(k) = h

                    'MsgBox ("Ca marche2")
                ElseIf LCase(TableauTargetSource(k)) <> LCase(TableauDestinationTarget(j)) And Verification2 = True Then
        '            For a = l To n
        '                Verification = True
        '                If TableauTargetSource(a) = TableauTargetSource(k) Then
                            Verification = False
                            Verification2 = False
        '                End If
        '                If Verification = True Then
                            k = k + 1
                            TableauIdSource(k) = TableauIdentifiant(i)
                            TableauTargetSource(k) = TableauDestinationTarget(j)
                            TableauValeurSource(k) = 1
        '                    n = n + 1
        '                End If
        '            Next
                End If
            End If
        Next
        l = n
        'MsgBox ("Ca marche")
        k = k + 1
Next

derniere_ligne2 = Sheets("Feuil5").Range("A1").End(xlDown).Row
'MsgBox (derniere_colonne)


'Cette partie permet de convertir les noms des ID en un langage lisible par Gephi, des numéros. Chaque instituts a son propre
'numéro et c'est ce qu'on affichera au final


For i = 2 To derniere_ligne
    For j = 2 To derniere_colonne - 1
        'MsgBox ("Comparant : " & LCase(Ws_Feuille_Identifiant.Cells(i, 2)) & "    Comparer : " & LCase(Ws_Feuille_Source.Cells(i, 2)))
        If LCase(TableauTargetSource(i)) = LCase(TableauIdentifiant(j)) Then
            TableauTargetSource(i) = j - 1
        End If
    Next
Next


For i = 2 To derniere_ligne
    For j = 1 To derniere_ligne3
       If LCase(TableauIdSource(i)) = LCase(TableauIdentifiant(j)) Then
            TableauIdSource(i) = j
        End If
    Next
Next

For i = 2 To derniere_ligne
    For j = 1 To derniere_ligne3
       If LCase(TableauTargetSource(i)) = LCase(TableauIdentifiant(j)) Then
            TableauTargetSource(i) = j
        End If
    Next
Next


Application.ScreenUpdating = False


            
For i = 1 To k
    Ws_Feuille_Source.Cells(i + 1, 1) = TableauIdSource(i)
    Ws_Feuille_Source.Cells(i + 1, 2) = TableauTargetSource(i)
    Ws_Feuille_Source.Cells(i + 1, 3) = TableauValeurSource(i)
Next

Application.ScreenUpdating = True






QueryPerformanceCounter Fin
QueryPerformanceFrequency Freq
MsgBox "Traitement effectué en " & Format(((Fin - Debut) / Freq), "0.00") & " s"
End Sub