Bonjour j'utilise ce code ci dessous et je me demandais si quelqun pourrait le modifier afin que ma macro aille plus vite...
J'ai un document de 1400 lignes et une 40aine de colonnes et ma macro prend 45 minutes en temps d'execution
Merci beaucoup
Bonne soirée
Code :
Sub Bouton5_Clic()
Application.ScreenUpdating = False
Dim WS_Doublon As Worksheet
Set WS_Doublon = Worksheets("QV")
Dim fin_Doublon As Long
fin_Doublon = WS_Doublon.Range("A65536").End(xlUp).Row
Dim pcs_Doublon As Long
Dim val_colA As String
Dim val_colE As String
'On parcourt le tableau à l'inverse pour ne pas être géné par la suppression des lignes
For pcs_Doublon = fin_Doublon To 7 Step -1 '(le 1 est à remplacer par ta ligne de début)
val_colA = WS_Doublon.Cells(pcs_Doublon, 1).Value
val_colE = WS_Doublon.Cells(pcs_Doublon, 5).Value
'On teste les conditions
'On vérifie si le texte de la cellule en A CONTIENT "N", et si le texte de la cellule en E CONTIENT "Inventory Total Gross"
'/!\ Le texte testé peut être plus grand que le critère de recherche
If (val_colA Like "*N*") And (val_colE Like "*13 - INVENTORY -- Total Gross inventory (k€)*") Then
WS_Doublon.Rows(CStr(pcs_Doublon) & ":" & CStr(pcs_Doublon)).Delete shift:=xlUp
End If
Next pcs_Doublon
Application.ScreenUpdating = False
Sheets("Final extraction").Range("A2:F" & Rows.Count).ClearContents
ligne = 2
dercol = Sheets("QV").Cells(1, Columns.Count).End(xlToLeft).Column - 3
derlin = Sheets("QV").Cells(Rows.Count, 3).End(xlUp).Row
tablo = Sheets("QV").Range(Sheets("QV").Cells(1, 1), Sheets("QV").Cells(derlin, dercol))
For n = 3 To UBound(tablo, 1)
For m = 8 To UBound(tablo, 2)
If tablo(n, m) <> "" And tablo(n, m) <> "-" And tablo(n, m) <> 0 Then
Sheets("Final extraction").Cells(ligne, 1) = tablo(n, 4)
Sheets("Final extraction").Cells(ligne, 2) = tablo(n, 3)
Sheets("Final extraction").Cells(ligne, 3) = tablo(n, 5)
Sheets("Final extraction").Cells(ligne, 4) = tablo(2, m)
Sheets("Final extraction").Cells(ligne, 5) = tablo(1, m)
Sheets("Final extraction").Cells(ligne, 6) = tablo(n, m)
ligne = ligne + 1
End If
Next
ligne = ligne + 1
Next
Application.ScreenUpdating = False
Sheets("Final extraction").Select
MsgBox "Updated"
End Sub
J'ai un document de 1400 lignes et une 40aine de colonnes et ma macro prend 45 minutes en temps d'execution
Merci beaucoup
Bonne soirée
Code :
Sub Bouton5_Clic()
Application.ScreenUpdating = False
Dim WS_Doublon As Worksheet
Set WS_Doublon = Worksheets("QV")
Dim fin_Doublon As Long
fin_Doublon = WS_Doublon.Range("A65536").End(xlUp).Row
Dim pcs_Doublon As Long
Dim val_colA As String
Dim val_colE As String
'On parcourt le tableau à l'inverse pour ne pas être géné par la suppression des lignes
For pcs_Doublon = fin_Doublon To 7 Step -1 '(le 1 est à remplacer par ta ligne de début)
val_colA = WS_Doublon.Cells(pcs_Doublon, 1).Value
val_colE = WS_Doublon.Cells(pcs_Doublon, 5).Value
'On teste les conditions
'On vérifie si le texte de la cellule en A CONTIENT "N", et si le texte de la cellule en E CONTIENT "Inventory Total Gross"
'/!\ Le texte testé peut être plus grand que le critère de recherche
If (val_colA Like "*N*") And (val_colE Like "*13 - INVENTORY -- Total Gross inventory (k€)*") Then
WS_Doublon.Rows(CStr(pcs_Doublon) & ":" & CStr(pcs_Doublon)).Delete shift:=xlUp
End If
Next pcs_Doublon
Application.ScreenUpdating = False
Sheets("Final extraction").Range("A2:F" & Rows.Count).ClearContents
ligne = 2
dercol = Sheets("QV").Cells(1, Columns.Count).End(xlToLeft).Column - 3
derlin = Sheets("QV").Cells(Rows.Count, 3).End(xlUp).Row
tablo = Sheets("QV").Range(Sheets("QV").Cells(1, 1), Sheets("QV").Cells(derlin, dercol))
For n = 3 To UBound(tablo, 1)
For m = 8 To UBound(tablo, 2)
If tablo(n, m) <> "" And tablo(n, m) <> "-" And tablo(n, m) <> 0 Then
Sheets("Final extraction").Cells(ligne, 1) = tablo(n, 4)
Sheets("Final extraction").Cells(ligne, 2) = tablo(n, 3)
Sheets("Final extraction").Cells(ligne, 3) = tablo(n, 5)
Sheets("Final extraction").Cells(ligne, 4) = tablo(2, m)
Sheets("Final extraction").Cells(ligne, 5) = tablo(1, m)
Sheets("Final extraction").Cells(ligne, 6) = tablo(n, m)
ligne = ligne + 1
End If
Next
ligne = ligne + 1
Next
Application.ScreenUpdating = False
Sheets("Final extraction").Select
MsgBox "Updated"
End Sub