XL 2016 accélerer une macro en utilisant un tableau à une dimension

FRANCOIS GROSJEAN

XLDnaute Nouveau
Bonjour,
J'ai une macro pour aller copier et coller des valeurs d'un tableau excel sur un autre en fonction de valeur située dans un 3° tableau excel
Par contre ces tableaux ne sont pas définis dans VBA : ils sont utilisés dans la macro en utilisant les références sheets(range("x":"y")
Comme j'ai beaucoup de données cette macro met jusqu'à 35 sec pour se réaliser
J'aimerais savoir comment (ou si) on peut l'accéler en définissant les tableaux dans la macro VBA ?
Avec mes remerciements
Francois

Sub Tri_1()
Application.ScreenUpdating = False
Dim T
T = Timer()
Dim Clef As String
Dim V
Dim i As Integer
Dim Cpt
Cpt = WorksheetFunction.CountA(Sheets("Liste_fournisseurs").Range("D10:D35"))
'=nbval de la plage D10:D35 cela permet de s'arrêter à la derniàre cellule non vide sinon le vide est remplacé sur toute la feuille "Result"

For i = 1 To Cpt
V = Sheets("Liste_fournisseurs").Cells(9 + i, 4)
Clef = "*" & UCase(V) & "*" 'il faut tout mettre en majuscule par Ucase pour s'affranchir de la "casse"
Dim rng As Range
Dim cell As Range
Sheets("Result").Select
Set rng = ActiveSheet.Range("AD2:" & ActiveSheet.Range("AD30000").End(xlUp).Address)
' Selection de AD2 à la dernière ligne non vide de la colonne AD
For Each cell In rng
If UCase(cell) Like Clef Then 'il faut tout mettre en majuscule par Ucase pour s'affranchir de la "casse"
cell = Sheets("Liste_fournisseurs").Cells(9 + i, 5)
Else
End If
Next cell
Next
Application.ScreenUpdating = True
MsgBox "Enfin Termin? !! " & Timer() - T
End Sub
 
Solution
Après plusieurs recherche sur internet j'ai fini par trouver la bonne syntaxe complète pour gagner en rapidité. NB : J'ai constaté que souvent les réponses peuvent être que partielle car les personnes qui répondent pensent probablement que le demandeur connait déjà excel ou VBA. En l’occurrence des omissions dans un code qui peuvent sembler "banales" ou "basiques" peuvent empêcher l'interlocuteur de comprendre et reproduire le code..... Vous trouverez donc ci-joint un fichier qui au final m'a permis de passer de 145 secondes à moins de 2 sec sur une action de remplacement de texte dans toutes les lignes d'une colonne.
A dispo pour les gens qui veulent plus d'infos.
Que fait le fichier ?
1) Il permet en fonction d'un code sélectionné...

Dranreb

XLDnaute Barbatruc
Bonsoir.
Je ne travaille jamais directement avec les cellule justement parce que je sais que c'est très lent.
Vous parlez de tableaux Excel. Pour le tableau VBA d'entrée, à déclarer par exemple TEnt(), vous pouvez l'initialiser en faisant
TEnt = ActiveSeet.ListObjects(1).DataBodyRange.Value et travailler ensuite avec les éléments du tableau dans une boucle For L = 1 To Ubound(TEnt, 1), c'est bien plus rapide.
 

FRANCOIS GROSJEAN

XLDnaute Nouveau
Après plusieurs recherche sur internet j'ai fini par trouver la bonne syntaxe complète pour gagner en rapidité. NB : J'ai constaté que souvent les réponses peuvent être que partielle car les personnes qui répondent pensent probablement que le demandeur connait déjà excel ou VBA. En l’occurrence des omissions dans un code qui peuvent sembler "banales" ou "basiques" peuvent empêcher l'interlocuteur de comprendre et reproduire le code..... Vous trouverez donc ci-joint un fichier qui au final m'a permis de passer de 145 secondes à moins de 2 sec sur une action de remplacement de texte dans toutes les lignes d'une colonne.
A dispo pour les gens qui veulent plus d'infos.
Que fait le fichier ?
1) Il permet en fonction d'un code sélectionné dans un onglet "1" de sélectionner toutes les lignes contenant ce code dans l'onglet "2" et de les coller dans l'onglet "3" = gain 10 sec
2) de remplacer le texte qui se trouve dans chaque ligne d'une colonne par des textes simplifiés = avec beaucoup de données à traiter cela permet de réduire de 145 sec à 2 sec le temps de traitement !
Ci_dessous les codes pour le remplacement de texte : Tri_2() = macro rapide et Tri_(1) = macro lente voir très lente...

il s'agit des codes saisis exactement dans mon fichier:

Option Explicit

Sub Tri_2()
' ==> marche très bien et fait bien une recherche que sur une partie du mot : dure moins de 2 secondes

Dim T
T = Timer()

Application.ScreenUpdating = False
On Error Resume Next
Sheets("Result").ShowAllData

Dim V
Dim Clef As String
Dim Cpt
Cpt = WorksheetFunction.CountA(Sheets("Liste_fournisseurs").Range("D10:D70"))

Dim Montab As Variant, i As Long, J As Long
Montab = Sheets("Result").Range("AD2:AD30000").value

For J = 1 To Cpt
V = Sheets("Liste_fournisseurs").Cells(9 + J, 4)
' MsgBox V
Clef = "*" & UCase(V) & "*"
'il faut tout mettre en majuscule par Ucase pour s'affranchir de la "casse"
'MsgBox "Clef =" & Clef

For i = LBound(Montab, 1) To UBound(Montab, 1)
If UCase(Montab(i, 1)) Like Clef Then

'il faut tout mettre en majuscule par Ucase pour s'affranchir de la "casse"
Montab(i, 1) = Sheets("Liste_fournisseurs").Cells(9 + J, 5)
Else
End If
Next i
Next J

Sheets("Result").Range("AD2:AD30000").value = Montab

Application.ScreenUpdating = True
Range("A1").Select
MsgBox Timer() - T

End Sub

Sub Tri_1()
'qui marche très très bien et avec une boucle !!! mais QUI DURE PLUS LONGTEMPS QUE Tri_2 jusqu'à 145 sec si beaucoup de donnée !!!

Application.ScreenUpdating = False
Dim T
T = Timer()

Dim Clef As String
Dim V
Dim i As Integer
Dim Cpt
Cpt = WorksheetFunction.CountA(Sheets("Liste_fournisseurs").Range("D10:D35"))
'=nbval de la plage D10:D35 cela permet de s'arrêter à la dernière cellule non vide sinon le vide est remplacé sur tout la feuille "Result"

For i = 1 To Cpt
V = Sheets("Liste_fournisseurs").Cells(9 + i, 4)
Clef = "*" & UCase(V) & "*"
'il faut tout mettre en majuscule par Ucase pour s'affranchir de la "casse"
Dim rng As Range
Dim Cell As Range
Sheets("Result").Select
Set rng = ActiveSheet.Range("AD2:" & ActiveSheet.Range("AD30000").End(xlUp).Address)

'Set rng = Selection de AD2 à la dernière ligne non vide de la colonne AD

For Each Cell In rng
If UCase(Cell) Like Clef Then
'il faut tout mettre en majuscule par Ucase pour s'affranchir de la "casse"
Cell = Sheets("Liste_fournisseurs").Cells(9 + i, 5)
Else
End If
Next Cell
Next
Application.ScreenUpdating = True
MsgBox "Enfin Terminé !! " & Timer() - T

End Sub
 

Discussions similaires

Statistiques des forums

Discussions
312 198
Messages
2 086 149
Membres
103 132
dernier inscrit
hedfahmi