Bonjour a vous cher(e)s ami(e)s du forum,


J'ai un procédure fonctionnel mais très lente auquel je voudrais remplacer par quelques chose de plus rapide, si cela est possible.



Voici donc la procédure en question

Code : Sélectionner tout - Visualiser dans une fenêtre à part
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
Sub copie_noproduit_ancienne_longue_et_mandat()
 
Dim x As Long
Dim cell As Variant
Dim LettreVoulue As String
LettreVoulue = TrouveLettreColonne([no_item_travail])
 
On Error GoTo errohandler:
 
Application.ScreenUpdating = False
 
Sheets("Travail").Select
 
For Each cell In Worksheets("Travail").Range(LettreVoulue & 2, LettreVoulue & LastLignUsedInColumn(LettreVoulue))
 
        x = x + 1
 
'nettoyer les no d'item
 
    Sheets("Travail").Cells(x + 1, [no_item_travail].Column) = _
    StripAccent(UCase(CleanTrim(Sheets("Travail").Cells(x + 1, [no_item_travail].Column).value)))
 
 
'recherche et copie de l'ancienne provinciale longue
 
    Sheets("Travail").Cells(x + 1, [ancienne_prov_longue].Column) = Application.VLookup(Sheets("Travail").Cells _
    (x + 1, [no_item_travail].Column), _
    Worksheets("catalogue").Range("A1").CurrentRegion, 3, False)
 
 
'recherche et copie du no produit
 
    Sheets("Travail").Cells(x + 1, [no_produit_travail].Column) = Application.VLookup(Sheets("Travail").Cells _
    (x + 1, [no_item_travail].Column), _
    Worksheets("catalogue").Range("A1").CurrentRegion, 2, False)
 
 
'recherche et copie mandat
 
    Sheets("Travail").Cells(x + 1, [mandat_lac].Column) = rmult(Sheets("Travail").Cells _
    (x + 1, [no_item_travail].Column), _
    Worksheets("mandat").Range("A1").CurrentRegion, 2)
 
 
    Next cell
 
Application.ScreenUpdating = True
 
Exit Sub
 
errohandler:
 
Application.ScreenUpdating = True
MsgBox "erreur sur la ligne " & x + 1, vbCritical
 
End Sub
DOnt celle-ci contient les procédures et/ou fontions suivantes :


Code : Sélectionner tout - Visualiser dans une fenêtre à part
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
 
Public Function TrouveLettreColonne(ByVal ColonneCherche As Range) As String
 
TrouveLettreColonne = Split(Columns(ColonneCherche.Column).Address(ColumnAbsolute:=False), ":")(1)
 
End Function
 
Public Function LastLignUsedInColumn(NomColumn As String)
 
LastLignUsedInColumn = Range(NomColumn & Rows.Count).End(xlUp).Row
 
End Function
 
Function CleanTrim(ByVal S As String, Optional ConvertNonBreakingSpace As Boolean = True) As String
 
    Dim x As Long, CodesToClean As Variant
 
    CodesToClean = Array(0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17, 18, 19, 20, _
                         21, 22, 23, 24, 25, 26, 27, 28, 29, 30, 31, 127, 129, 141, 143, 144, 157)
 
    If ConvertNonBreakingSpace Then S = Replace(S, Chr(160), " ")
 
    For x = LBound(CodesToClean) To UBound(CodesToClean)
 
    If InStr(S, Chr(CodesToClean(x))) Then S = Replace(S, Chr(CodesToClean(x)), "")
 
    Next
 
    CleanTrim = WorksheetFunction.Trim(S)
 
End Function
 
Function rmult(valeurachercher As Variant, plageachercher As Range, numcolonne As Long) As Variant
    Dim u As Variant
    Dim nb As Long
    Dim boucle As Long
 
    For boucle = 1 To plageachercher.Rows.Count
 
        If plageachercher(boucle, 1) = valeurachercher Then
            u = u & plageachercher(boucle, numcolonne) & Chr(10)
            nb = nb + 1
        End If
 
    Next boucle
 
    If Right$(u, 1) = Chr(10) Then u = Left$(u, Len(u) - 1)
 
    rmult = u
 
End Function
Cette procédure permet de populer un fichier de travail. Elle fait 2 vlookup afin de populer de l'information pertinente ainsi que la fonction rmult qui est comme un vlookup mais renvoi toute les données possibles contrairement a vlookup qui renvoi seulement le premier trouvé. C'Est à mon avis cette dernière fonction qui ralenti un peu mon processus.


Donc j'ai deux questions sois pouvont nous effectuer cette popuilation de mon fichier en lot ou block au lieu de passé ligne par ligne ??? Si cette dernière n'Est pas possible avez vous une solution afin de rendre plus rapide la fonction rmult ???




merci d'avance pour le temps consacrer a m'aider, c'est plus qu'apprécié !!!

amicalement JP