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("D1035"))
'=nbval de la plage D1035 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
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("D1035"))
'=nbval de la plage D1035 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