Macro qui prend plus de 2 jours.

[kevenpom]

Bonjour,


J'ai réussi a utilise un tableau avec beaucoup de temps,
Mais comment faire pour stocker dans un tableau mon

Worksheets("decomposition").Cells(m, l).Value = Worksheets("selection").Cells(i, 17).Value

pour le coller d'un seul coup a la fin au lieu d'écrire dans chaque cellule a chaque fois.

croyez vous qu'il y a une méthode plus rapide ?


voici mon code :

Sub partlist()

Dim WS1, WS2 As Worksheet
Dim lastrow, lastrow2, Source, source2, tablo(), max, max2, i, l, k, m As Long
Dim CelluleDeb, restante As Long

Set WS1 = ThisWorkbook.Sheets("selection")
Set WS2 = ThisWorkbook.Sheets("decomposition")
max = WS1.Range("O65536").End(xlUp).Row
max2 = WS2.Range("A65536").End(xlUp).Row
Source = WS1.Range(WS1.Range("A1"), WS1.Range("Q" & max)).Value
source2 = WS2.Range(WS2.Range("A1"), WS2.Range("A" & max2)).Value

For m = 1 To max2
    l = 2
    For i = 1 To max
    k = 1
    If Source(i, 1) = Mid(source2(m, 1), 1, 2) Or Source(i, 1) = "" Then k = k + 1
    If Source(i, 2) = Mid(source2(m, 1), 3, 3) Or Source(i, 2) = "" Then k = k + 1
    If Source(i, 3) = Mid(source2(m, 1), 6, 1) Or Source(i, 3) = "" Then k = k + 1
    If Source(i, 4) = Mid(source2(m, 1), 7, 1) Or Source(i, 4) = "" Then k = k + 1
    If Source(i, 5) = Mid(source2(m, 1), 8, 2) Or Source(i, 5) = "" Then k = k + 1
    If Source(i, 6) = Mid(source2(m, 1), 10, 1) Or Source(i, 6) = "" Then k = k + 1
    If Source(i, 7) = Mid(source2(m, 1), 11, 1) Or Source(i, 7) = "" Then k = k + 1
    If Source(i, 8) = Mid(source2(m, 1), 12, 1) Or Source(i, 8) = "" Then k = k + 1
    If Source(i, 9) = Mid(source2(m, 1), 13, 1) Or Source(i, 9) = "" Then k = k + 1
    If Source(i, 10) = Mid(source2(m, 1), 14, 1) Or Source(i, 10) = "" Then k = k + 1
    If Source(i, 11) = Mid(source2(m, 1), 15, 2) Or Source(i, 11) = "" Then k = k + 1
    If Source(i, 12) = Mid(source2(m, 1), 17, 1) Or Source(i, 12) = "" Then k = k + 1
    If Source(i, 13) = Mid(source2(m, 1), 18, 1) Or Source(i, 13) = "" Then k = k + 1
    If Source(i, 14) = Mid(source2(m, 1), 19, 1) Or Source(i, 14) = "" Then k = k + 1
    If k = 15 Then
        Worksheets("decomposition").Cells(m, l).Value = Worksheets("selection").Cells(i, 17).Value
        l = l + 1
        End If
    End If
Next
Next
Application.ScreenUpdating = True

 

[BOISGONTIER]

Re : Macro qui prend plus de 2 jours.

Bonjour,

Utiliser un tableau et le transférer dans le tableur.

Les tableaux

JB

 

[kevenpom]

Re : Macro qui prend plus de 2 jours.

Donc je créer un tableau a 2 dimension qui aurait 25600 ligne par plusieur colonne. et le colle a la fin
Est-ce que le reste de ma macro est optimisé ou il y aurait possibilité d'optimisé encore.

Merci