Optimisation copier/coller ligne à ligne à en tableau

Je cherche à optimiser mon code en utilisant des tableaux.

Ce code me permet de copier/coller des zones, centres et items, selon la zone et ce ligne à ligne ce qui prend un temps certain quand la liste s’allonge…

Sub copy_item_to_zone() ' Copie des items dans les zones concerné

Dim Wb_dest As String

Dim Wb_dep As String

Dim loc As String

Dim i, p As Integer

Dim sPass As String

Dim derlg As Integer

sPass = InputBox("Veuillez saisir le mot de passe") 'Gestion MDP

If sPass = "PP" Then

Wb_dep = ActiveWorkbook.Name

For p = 6 To Workbooks(Wb_dep).Sheets("zone").Range("A65536").End(xlUp).Row 'regarde les différentes zones pour créer la variable loc

Sheets("zone").Select

loc = Cells(p, 1)

Ligne = 5

For i = 2 To Workbooks(Wb_dep).Sheets("Pré-Montage").Range("E65536").End(xlUp).Row

If Workbooks(Wb_dep).Sheets("Pré-Montage").Range("E" & i) = loc Then

Workbooks(Wb_dep).Sheets("Pré-Montage").Range("E" & i & ":F" & i).copy 'Copie des zones et centres

Workbooks(Wb_dep).Sheets(loc).Range("A" & Ligne).PasteSpecial Paste:=xlPasteValues

Workbooks(Wb_dep).Sheets("Pré-Montage").Range("M" & i).copy 'Copie des items

Workbooks(Wb_dep).Sheets(loc).Range("C" & Ligne).PasteSpecial Paste:=xlPasteValues

Workbooks(Wb_dep).Sheets("Pré-Montage").Range("L" & i).copy 'Copie du type d'IS

Workbooks(Wb_dep).Sheets(loc).Range("F" & Ligne).PasteSpecial Paste:=xlPasteValues

Ligne = Ligne + 1

End If

Next i

Sheets(loc).Select

derlg = ActiveSheet.Range("B65536").End(xlUp).Row

If derlg > 5 Then

Range("B5:B" & derlg).Sort Key1:=Range("B5")

End If

Next p

Sheets("zone").Select

End If

End Sub

Je voudrai donc passer par des tableaux pour optimiser le traitement (il paraitrait que ça fait la dif ) , de plus idéalement je veux rajouter une boucle de comparaison entre le tableau de la base de données et le tableau de la zone pour pouvoir activer cette macro n’importe quand sans risque d’écraser des données remplies dans la zone.

Ci-dessous ce que j’ai commencé :

Sub copy_item_to_zone2()

Dim Wb_dest As String

Dim Wb_dep As String

Dim loc As String

Dim der_lgne, der_lgneT As Integer

Dim i, e, p As Integer

Dim tab_Montage()

Dim tab_Tampon(1000, 4)

Dim tab_Loc(1000, 4)

Wb_dep = ActiveWorkbook.Name

For p = 6 To Workbooks(Wb_dep).Sheets("zone").Range("A65536").End(xlUp).Row 'regarde les différentes zones pour créer la variable loc

Sheets("zone").Select

loc = Cells(p, 1)

Sheets("Pré-montage").Select

der_lgne = Range("E5").End(xlDown).Row

Sheets(loc).Select

der_lgneL = Range("A5").End(xlDown).Row

ReDim tab_Montage(der_lgne - 5, 3)

For i = 0 To der_lgne 'tableau des items de l'onglet Pré-montage

tab_Montage(i, 0) = Sheets("Pré-montage").Range("E" & i + 5)

tab_Montage(i, 1) = Sheets("Pré-montage").Range("F" & i + 5)

tab_Montage(i, 2) = Sheets("Pré-montage").Range("L" & i + 5)

tab_Montage(i, 3) = Sheets("Pré-montage").Range("M" & i + 5)

Next i

For i = 0 To der_lgne

If tab_Montage(i, 0) = loc Then 'tableau des items de la loc en cours via le pré-montage

tab_Montage(i, 0) = tab_Tampon(i, 0)

tab_Montage(i, 1) = tab_Tampon(i, 1)

tab_Montage(i, 2) = tab_Tampon(i, 2)

tab_Montage(i, 3) = tab_Tampon(i, 3)

For i = 0 To 1000 'tableau actuel des items de la loc

tab_Loc(i, 0) = Sheets(loc).Range("A" & i + 5)

tab_Loc(i, 1) = Sheets(loc).Range("B" & i + 5)

tab_Loc(i, 2) = Sheets(loc).Range("C" & i + 5)

tab_Loc(i, 3) = Sheets(loc).Range("F" & i + 5)

Next i

For i = 0 To der_lgneL 'comparaison des items entre le pré-montage et la loc en cours

For e = 0 To 1000

If tab_Loc(i, 1) <> tab_Tampon(e, 1) & tab_Loc(i, 2) <> tab_Tampon(e, 2) Then

tab_Loc(der_lgneL + 1, 0) = tab_Tampon(e, 0)

tab_Loc(der_lgneL + 1, 1) = tab_Tampon(e, 1)

tab_Loc(der_lgneL + 1, 2) = tab_Tampon(e, 2)

tab_Loc(der_lgneL + 1, 3) = tab_Tampon(e, 3)

Next e

Next i

Sheets(loc).Select

If derlg > 5 Then

Range("B5:B" & derlg).Sort Key1:=Range("B5")

End If

Next p

End Sub

J'ai un problème sur ma dernière boucle je souhaiterai que si la zone et l'item sont différents de ce qui est déjà dans le tableau loc l'ajouté à la fin, mais je ne peux pas utiliser ma variable der_lgneL au risque de la changer dans ma boucle.

J'espère avoir été suffisamment claire et qu'une âme charitable volera à mon secours.

Bonjour,

Les boucles, entre "sur la feuille" et "en variable tableau", se codent de la même façon.

Par contre, il est vrai, que, une boucle sur variable tableau est BEAUCOUP plus rapide que de boucler sur les cellules d'une feuille...

Voici un exemple de code pour alimenter une variable tableau à partir des données d'une feuille :

    Sub Essai()
    Dim myTab As Variant, i As Long, j As Long
    myTab = Range_To_Tb(Worksheets("Feuil1").Range("B2:X125")) 'Range pour l'exemple...
        For i = LBound(myTab, 1) To UBound(myTab, 1)
            For j = LBound(myTab, 2) To UBound(myTab, 2)
                Debug.Print myTab(i, j)
            Next j
        Next i
    End Sub
    Public Function Range_To_Tb(plage As Range) As Variant()
        If plage.Cells.Count < 2 Then
           Dim tablo(1 To 1, 1 To 1)
           tablo(1, 1) = plage.Value
           Range_To_Tb = tablo
           Erase tablo
         Else
           Range_To_Tb = plage.Value
         End If
    End Function

Merci pour l'exemple, j'avais vu des exemples avec UBound, LBound est la même chose pour trouver le début ?

La fonction Debug print renvoie quoi ?

Si je veux ajouter des lignes à un tableau borner avec un UBound ça fonctionne comment ?

Si j'ai deux tableaux un source et un autre avec des données qui sont en double du source, si mon deuxième tableau est borné comment ajouter les nouvelles données source?

Salut Pijaku,

Comment je fais si je souhaite créer un tableau avec des colonnes non consécutive ?

Dans mon exemple les colonnes E,F,L,M

myTab = Range_To_Tb(Worksheets("Feuil1").Range("E5:F1000;L5:M1000"))

Peux tu m'expliquer la seconde partie du code que je ne comprends pas

Public Function Range_To_Tb(plage As Range) As Variant()

If plage.Cells.Count < 2 Then

Dim tablo(1 To 1, 1 To 1)

tablo(1, 1) = plage.Value

Range_To_Tb = tablo

Erase tablo

Else

Range_To_Tb = plage.Value

End If

End Function

Bonjour,

Comment je fais si je souhaite créer un tableau avec des colonnes non consécutive ?

Dans mon exemple les colonnes E,F,L,M

Tu ne peux pas.

En fait, la solution consiste à "tout prendre" les données E:M et de ne traiter que celles utiles.

Debug.Print inscrit, dans la fenêtre exécution de VBE, la valeur de ta variable.

Ceci est une fonction qui créé une variable tableau à partir d'un Range transmis en paramètre. Je l'ai commentée.

Public Function Range_To_Tb(plage As Range) As Variant()
If plage.Cells.Count < 2 Then 'Si la plage ne contient qu'une cellule
   Dim tablo(1 To 1, 1 To 1) 'on dimensionne un tableau de 1 sur 1 (comme la plage de données)
   tablo(1, 1) = plage.Value  'et on lui attribue la valeur de la plage (ici 1 seule cellule)
   Range_To_Tb = tablo 'retour de la fonction
   Erase tablo  'on efface la variable tableau 
Else                                       'SINON
   Range_To_Tb = plage.Value 'on attribue directement les valeurs de la plage à notre variable tableau
End If  'FIN SI
End Function 'FIN

Merci pour ces explications, je vais essayer de travailler avec ça pour obtenir ce que je souhaite.

Petite question, comment coller une ligne du tableau après la dernière ligne écrite d'un autre tableau ?

Tab_loc = Range_To_Tb(Worksheets(loc).Range("A5:F1000"))

For i = LBound(Tab_montage, 1) To UBound(Tab_montage, 1)

If Tab_montage(i, 0) = Tab_loc(i, 0) & Tab_montage(i, 1) = Tab_loc(i, 1) & Tab_montage(i, 8) = Tab_loc(i, 2) Then

Je souhaiterai coller la ligne de Tab-montage qui correspond aux critères après la dernière ligne écrite de Tab_loc ?

La dernière ligne remplie de la colonne E (par exemple) :

Sub essai()
Dim L As Long
L = derlig_reelle(WorkSheets("Feuil1").Columns(5))
MsgBox L + 1
End Sub
    Public Function derlig_reelle(plage As Range) As Long
       If WorksheetFunction.CountA(plage) = 0 Then derlig_reelle = plage.Cells(1, 1).Row: Exit Function
       derlig_reelle = plage.Find("*", , , , , xlPrevious).Row
    End Function

Si je comprends bien tu trouves la dernière ligne du tableau en récupérant la dernière ligne de la feuille.

N'est il pas possible de regarder directement dans le tableau la dernière ligne ?

Souhaitant ajouter plusieurs lignes cette méthode ne me semble pas adéquate.