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 )
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.