XL 2016 Optimisation code vba

  • Initiateur de la discussion Initiateur de la discussion Sophia_13
  • Date de début Date de début

Boostez vos compétences Excel avec notre communauté !

Rejoignez Excel Downloads, le rendez-vous des passionnés où l'entraide fait la force. Apprenez, échangez, progressez – et tout ça gratuitement ! 👉 Inscrivez-vous maintenant !

Sophia_13

XLDnaute Nouveau
Bonjour a tous,

Je souhaiterai optimiser le code joint dans le fichier et mis ci-dessous, le but de cette macro est mettre le code suivi hors ligne et autre dans les colonnes de AP a DQ ( en fonction de la salle (A, B, C, …). Voici ma macro et le fichier en fichier joint.
Dans ce fichier la macro est rapide mais mon fichier d'origine contient beaucoup plus de colonnes (plus de 100 000 lignes pour les deux feuilles)

Pouvez vous m'aidez?

Code:
Sub TEST() '20 min 10

    Dim ligne As Long, ligne1 As Long, c As Long, i As Long, j As Long, l As Long
    
    ligne = Workbooks("Classeur3.xlsm").Sheets("Feuil2").Range("A1").End(xlDown).Row
    ligne1 = Workbooks("Classeur3.xlsm").Sheets("Feuil1").Range("D1").End(xlDown).Row
    
    ReDim T_site(ligne1, 8)
    ReDim T_d(ligne, 2)

Workbooks("Classeur3.xlsm").Sheets("Feuil1").Activate
    
    c = 1
    For i = 2 To ligne1
    If Range("O" & i) <> "" Then
    
        T_site(c, 0) = Range("B" & i).Value 'tranche
        T_site(c, 1) = Range("O" & i).Value & " - " & Range("C" & i).Value 'rf
        T_site(c, 2) = Range("D" & i).Value 'pmrqs
        T_site(c, 3) = Range("H" & i).Value 'freq
        T_site(c, 4) = Range("J" & i).Value 'tolerance
        T_site(c, 5) = Range("K" & i).Value 'type arret
        T_site(c, 6) = Range("L" & i).Value 'statut
        T_site(c, 7) = Range("M" & i).Value 'otm
        T_site(c, 8) = Range("O" & i).Value 'pmrqp
        c = c + 1
        
    End If
    Next
    
    Workbooks("Classeur3.xlsm").Sheets("Feuil2").Activate
    
    l = 1
    For i = 2 To ligne
        T_d(l, 0) = Range("AB" & i).Value & " - " & Mid(Range("AF" & i).Value, InStrRev(Range("AF" & i).Value, "_") + 1) 'pmrq
        T_d(l, 1) = Mid(Range("AF" & i).Value, InStrRev(Range("AF" & i).Value, "_") + 1) 'rf
        T_d(l, 2) = Range("AL" & i).Value 'otm
        l = l + 1
    Next
    
    ReDim T_f0(ligne, 7)
    ReDim T_f1(ligne, 7)
    ReDim T_f2(ligne, 7)
    ReDim T_f3(ligne, 7)
    ReDim T_f4(ligne, 7)
    ReDim T_f5(ligne, 7)
    ReDim T_f6(ligne, 7)
    ReDim T_f7(ligne, 7)
    ReDim T_f8(ligne, 7)
    ReDim T_f9(ligne, 7)
    
For j = 0 To UBound(T_site)
    For i = 0 To UBound(T_d)
 
    If (T_site(j, 1) = T_d(i, 0)) Then
        If T_site(j, 0) = "A" Then
        
            T_f0(i, 0) = T_site(j, 2)
            T_f0(i, 1) = T_site(j, 6)
            T_f0(i, 2) = ""
            T_f0(i, 3) = T_site(j, 7)
            T_f0(i, 4) = "conforme"
            T_f0(i, 5) = T_site(j, 3)
            T_f0(i, 6) = T_site(j, 5)
            T_f0(i, 7) = T_site(j, 4)
            
        End If
        If T_site(j, 0) = "B" Then
            T_f1(i, 0) = T_site(j, 2)
            T_f1(i, 1) = T_site(j, 6)
            T_f1(i, 2) = ""
            T_f1(i, 3) = T_site(j, 7)
            T_f1(i, 4) = "conforme"
            T_f1(i, 5) = T_site(j, 3)
            T_f1(i, 6) = T_site(j, 5)
            T_f1(i, 7) = T_site(j, 4)
            
        End If
        If T_site(j, 0) = "C" Then
            T_f2(i, 0) = T_site(j, 2)
            T_f2(i, 1) = T_site(j, 6)
            T_f2(i, 2) = ""
            T_f2(i, 3) = T_site(j, 7)
            T_f2(i, 4) = "conforme"
            T_f2(i, 5) = T_site(j, 3)
            T_f2(i, 6) = T_site(j, 5)
            T_f2(i, 7) = T_site(j, 4)
            
        End If
        If T_site(j, 0) = "D" Then
            T_f3(i, 0) = T_site(j, 2)
            T_f3(i, 1) = T_site(j, 6)
            T_f3(i, 2) = ""
            T_f3(i, 3) = T_site(j, 7)
            T_f3(i, 4) = "conforme"
            T_f3(i, 5) = T_site(j, 3)
            T_f3(i, 6) = T_site(j, 5)
            T_f3(i, 7) = T_site(j, 4)
        
        End If
        If T_site(j, 0) = "E" Then
            T_f4(i, 0) = T_site(j, 2)
            T_f4(i, 1) = T_site(j, 6)
            T_f4(i, 2) = ""
            T_f4(i, 3) = T_site(j, 7)
            T_f4(i, 4) = "conforme"
            T_f4(i, 5) = T_site(j, 3)
            T_f4(i, 6) = T_site(j, 5)
            T_f4(i, 7) = T_site(j, 4)
            
        End If
        If T_site(j, 0) = "F" Then
            T_f5(i, 0) = T_site(j, 2)
            T_f5(i, 1) = T_site(j, 6)
            T_f5(i, 2) = ""
            T_f5(i, 3) = T_site(j, 7)
            T_f5(i, 4) = "conforme"
            T_f5(i, 5) = T_site(j, 3)
            T_f5(i, 6) = T_site(j, 5)
            T_f5(i, 7) = T_site(j, 4)
            
        End If
        If T_site(j, 0) = "G" Then
            T_f6(i, 0) = T_site(j, 2)
            T_f6(i, 1) = T_site(j, 6)
            T_f6(i, 2) = ""
            T_f6(i, 3) = T_site(j, 7)
            T_f6(i, 4) = "conforme"
            T_f6(i, 5) = T_site(j, 3)
            T_f6(i, 6) = T_site(j, 5)
            T_f6(i, 7) = T_site(j, 4)
            
        End If
        If T_site(j, 0) = "H" Then
            T_f7(i, 0) = T_site(j, 2)
            T_f7(i, 1) = T_site(j, 6)
            T_f7(i, 2) = ""
            T_f7(i, 3) = T_site(j, 7)
            T_f7(i, 4) = "conforme"
            T_f7(i, 5) = T_site(j, 3)
            T_f7(i, 6) = T_site(j, 5)
            T_f7(i, 7) = T_site(j, 4)
            
        End If
        If T_site(j, 0) = "I" Then
            T_f8(i, 0) = T_site(j, 2)
            T_f8(i, 1) = T_site(j, 6)
            T_f8(i, 2) = ""
            T_f8(i, 3) = T_site(j, 7)
            T_f8(i, 4) = "conforme"
            T_f8(i, 5) = T_site(j, 3)
            T_f8(i, 6) = T_site(j, 5)
            T_f8(i, 7) = T_site(j, 4)
            
        End If
        If T_site(j, 0) = "J" Then
            T_f9(i, 0) = T_site(j, 2)
            T_f9(i, 1) = T_site(j, 6)
            T_f9(i, 2) = ""
            T_f9(i, 3) = T_site(j, 7)
            T_f9(i, 4) = "conforme"
            T_f9(i, 5) = T_site(j, 3)
            T_f9(i, 6) = T_site(j, 5)
            T_f9(i, 7) = T_site(j, 4)
            
        End If
        
    End If
    Next
    Next
    
    Range("AP1").Resize(UBound(T_f0, 1) + 1, UBound(T_f0, 2) + 1) = T_f0

    Range("AX1").Resize(UBound(T_f1, 1) + 1, UBound(T_f1, 2) + 1) = T_f1

    Range("BF1").Resize(UBound(T_f2, 1) + 1, UBound(T_f2, 2) + 1) = T_f2

    Range("BN1").Resize(UBound(T_f3, 1) + 1, UBound(T_f3, 2) + 1) = T_f3

    Range("BV1").Resize(UBound(T_f4, 1) + 1, UBound(T_f4, 2) + 1) = T_f4
 
    Range("CD1").Resize(UBound(T_f5, 1) + 1, UBound(T_f5, 2) + 1) = T_f5
 
    Range("CL1").Resize(UBound(T_f6, 1) + 1, UBound(T_f6, 2) + 1) = T_f6

    Range("CT1").Resize(UBound(T_f7, 1) + 1, UBound(T_f7, 2) + 1) = T_f7

    Range("DB1").Resize(UBound(T_f8, 1) + 1, UBound(T_f8, 2) + 1) = T_f8

    Range("DJ1").Resize(UBound(T_f9, 1) + 1, UBound(T_f9, 2) + 1) = T_f9



    Erase T_f0
    Erase T_f1
    Erase T_f2
    Erase T_f3
    Erase T_f4
    Erase T_f5
    Erase T_f6
    Erase T_f7
    Erase T_f8
    Erase T_f9
    Erase T_site
    Erase T_d
    
End Sub
 

Pièces jointes

- Navigue sans publicité
- Accède à Cléa, notre assistante IA experte Excel... et pas que...
- Profite de fonctionnalités exclusives
Ton soutien permet à Excel Downloads de rester 100% gratuit et de continuer à rassembler les passionnés d'Excel.
Je deviens Supporter XLD

Discussions similaires

  • Question Question
Microsoft 365 Export données
Réponses
4
Affichages
506
  • Question Question
Microsoft 365 worksheet_change
Réponses
29
Affichages
254
  • Question Question
Microsoft 365 VBA Transpose
Réponses
11
Affichages
756
Réponses
3
Affichages
601
  • Question Question
XL 2021 VBA excel
Réponses
4
Affichages
83
Retour