XL 2016 Macro, recopie selon critère sur plusieurs lignes

Marjo2

XLDnaute Occasionnel
Bonjour Forum,

Je cherche à recopier le chiffre qui se situe sur la ligne "Stock fin", colonne G dans la colonne Q correspondant à cet article (colonne M)
Dans la colonne Q, le même chiffre sur toutes les lignes de l'article concerné.

Si qté = 0 alors je peux supprimer les lignes


Merci beaucoup
 

Pièces jointes

  • TEST.xlsm
    71.4 KB · Affichages: 14

Robert

XLDnaute Barbatruc
Repose en paix
Re,

Le code ci-dessous s'exécute chez moi sur TEST5 en ± 18 secondes. Comme aucun Stock début n'a de valeur positive toutes les lignes devraient être effacées. Il me reste un bloc (qui ne contenait pas de stock début ni Stock fin donc c'est normal) et le premier bloc de la première référence (là je ne sais pas pourquoi)...
Le code :

VB:
Sub AvecStock2()
Dim O As Worksheet 'déclare la variable O (Onglet)
Dim TV As Variant 'déclare la variable TV (Tableau des Valeurs)
Dim NL As Long 'déclare la variable NL (Nombre de Lignes)
Dim I As Long 'déclare la variable I(Incrément)
Dim LF As Long 'déclare la variable LF (Ligne de Fin)
Dim LD As Long 'déclare la variable LD (Ligne de Début)
Dim LAD As Long 'déclare la variable LAD (Ligne À Déplacer)
Dim REF As String 'déclare la variable REF (REFérence)
Dim V As Double 'déclare la variable V (Valeur)
Dim DEB As Double '

DEB = Timer
Application.ScreenUpdating = False 'masque les rafraîchissement de l'Écran
Set O = Worksheets("EXPORT") 'définit l'onglet O
TV = O.Range("A1").CurrentRegion 'définit le tableau des valeurs TV
NL = UBound(TV, 1) 'définit le nombre de lignes NL du tableau des valeurs TV
For I = NL To 2 Step -1 'boucle inversée sur toutes les lignes I du tableau des valeurs TV (en partant de la seconde)
    If Trim(TV(I, 13)) <> "" Then 'condition 1 : si la donnée ligne I, colonne 13 de TV (la référence) n'est pas vide
        If TV(I, 5) = "Stock fin" Then 'condition 2 : si la donnée ligne I colonne 5 de TV vaut "Stock fin"
            LF = I + 1 'définit la ligne de fin LF
            REF = TV(I, 13) 'définit la référence REF
            O.Rows(I).Cut 'coupe la ligne I
            O.Rows(LF + 1).Insert Shift:=xlDown 'déplace la ligne I en dernière position
        End If 'fin de la condition 2
        'si la donnée ligne I colonne 5 vaut "Stock début" définit la valeur V, définit la ligne à déplacer LAD
        If TV(I, 5) = "Stock début" Then V = CDbl(TV(I, 7)): LAD = I
        'si la donnée ligne I colonne 13 est différence de la référence REF et que la ligne de fin LF n'est pas nulle, définit la ligne de début LD
        If TV(I, 13) <> REF And LF <> 0 Then LD = I + 1
        If LD <> 0 Then 'condition 3 : si LD n'est pas nulle
            O.Rows(LAD).Cut 'coupe la ligne LAD
            O.Rows(LD).Insert Shift:=xlDown 'déplace la ligne LAD en première position
            If V <> 0 Then 'codition4 : si Vn'est pas nulle
                O.Range(O.Cells(LD, "Q"), O.Cells(LF, "Q")).Value = V 'renvoie la valeur V dans la colonne Q des ligne LD à LF
            Else 'sinon (condition 4)
                O.Rows(LD & ":" & LF).Delete 'supprime les lignes LD à LF
            End If 'fin de la condition 4
            LD = 0: LF = 0 'réinitialise les variable LD et LF
        End If 'fin de la condition 3
    End If 'fin de la condition 1
Next I 'prochaine ligne de la boucle
O.Columns(17).NumberFormat = "0.000" 'formate la colonne Q
Application.ScreenUpdating = True 'affiche les rafraîchissement de l'Écran
MsgBox Timer - DEB
End Sub
 

Marjo2

XLDnaute Occasionnel
Je suis encore en train de chercher pourquoi ça ne fonctionne pas. Je pense que mon fichier est trop lourd.

Je me demandais la macro plus courte et rapide que tu as fait plus haut disais qu'elle bornait entre début et fin pour recopier la quantité colonne G en colonne Q pour toutes les lignes du même article colonne M.

Sur le coup l'export de l'ERP change de format donc on cherche à adapter et faire remonter la ligne en premier ce qui complique le code.
En plus tu me fais remarquer que dans l'export parfois il n'y a pas l'info stock début … Ca faut que je cherche de mon côté….

Il est pas possible de faire un chouille plus simple ?
Dans un tableau "fictif" on récupère la ligne stock fin avec sa qté (colonne G) et son code article (en colonne M)
Quand on a le même article (colonne M), on lui mets sur toutes ses lignes en colonne Q la valeur trouvé dans le tableau "fictif".
Pour finir on supprime les lignes dont la valeur en colonne Q serait à zéro.
Qu'en penses-tu ? C'est qu'une simple interrogation, en rien je ne sais ce qui est le plus simple à écrire ni le plus rapide….
 

Robert

XLDnaute Barbatruc
Repose en paix
Re,

C'est en gros exactement ce que fait la macro sauf que je déplace les lignes Stock fin (un ligne vers le bas) et Stock début (en première position). Je peux supprimer ces déplacement pour améliorer la vitesse de traitement mais je suis convaincu que le problème vient de la longueur de ton tableau car sur TEST5 chez moi, la macro s'est exécutée en 18 secondes sans planter. Pourquoi n'essaies-tu pas de diviser ton fichier un plusieurs tableaux (8 x 10000 lignes ou 10 x 8000 lignes) .

Le code sans les déplacements (mais franchement vu que j'ai pris la peine de tout commenter, tu aurais pu faire ça aussi bien que moi ...):
VB:
Sub AvecStock2()[/COLOR]
Dim O As Worksheet 'déclare la variable O (Onglet)
Dim TV As Variant 'déclare la variable TV (Tableau des Valeurs)
Dim NL As Long 'déclare la variable NL (Nombre de Lignes)
Dim I As Long 'déclare la variable I(Incrément)
Dim LF As Long 'déclare la variable LF (Ligne de Fin)
Dim LD As Long 'déclare la variable LD (Ligne de Début)
Dim LAD As Long 'déclare la variable LAD (Ligne À Déplacer)
Dim REF As String 'déclare la variable REF (REFérence)
Dim V As Double 'déclare la variable V (Valeur)
Dim DEB As Double '

DEB = Timer
Application.ScreenUpdating = False 'masque les rafraîchissement de l'Écran
Set O = Worksheets("EXPORT") 'définit l'onglet O
TV = O.Range("A1").CurrentRegion 'définit le tableau des valeurs TV
NL = UBound(TV, 1) 'définit le nombre de lignes NL du tableau des valeurs TV
For I = NL To 2 Step -1 'boucle inversée sur toutes les lignes I du tableau des valeurs TV (en partant de la seconde)
    If Trim(TV(I, 13)) <> "" Then 'condition 1 : si la donnée ligne I, colonne 13 de TV (la référence) n'est pas vide
        If TV(I, 5) = "Stock fin" Then 'condition 2 : si la donnée ligne I colonne 5 de TV vaut "Stock fin"
            LF = I + 1 'définit la ligne de fin LF
            REF = TV(I, 13) 'définit la référence REF
        End If 'fin de la condition 2
        'si la donnée ligne I colonne 5 vaut "Stock début" définit la valeur V, définit la ligne à déplacer LAD
        If TV(I, 5) = "Stock début" Then V = CDbl(TV(I, 7)): LAD = I
        'si la donnée ligne I colonne 13 est différence de la référence REF et que la ligne de fin LF n'est pas nulle, définit la ligne de début LD
        If TV(I, 13) <> REF And LF <> 0 Then LD = I + 1
        If LD <> 0 Then 'condition 3 : si LD n'est pas nulle
            If V <> 0 Then 'codition4 : si V n'est pas nulle
                O.Range(O.Cells(LD, "Q"), O.Cells(LF, "Q")).Value = V 'renvoie la valeur V dans la colonne Q des ligne LD à LF
            Else 'sinon (condition 4)
                O.Rows(LD & ":" & LF).Delete 'supprime les lignes LD à LF
            End If 'fin de la condition 4
            LD = 0: LF = 0 'réinitialise les variable LD et LF
        End If 'fin de la condition 3
    End If 'fin de la condition 1
Next I 'prochaine ligne de la boucle
O.Columns(17).NumberFormat = "0.000" 'formate la colonne Q
Application.ScreenUpdating = True 'affiche les rafraîchissement de l'Écran
MsgBox Timer - DEB
End Sub
 

Marjo2

XLDnaute Occasionnel
Bonjour Robert,
Merci mais même en réduisant mon nombre de ligne, la quantité ne se met pas en colonne Q.
Depuis plusieurs jours, j'ai cherché à modifier/adapter le code vba mais je n'ai pas réussi.
J'ai donc cherché une autre idée et je me dis qu'une formule index/equiv/décaler devrait pouvoir fonctionner (je cherche encore sur le forum et essaie d'adapter mais en vain pour le moment). Et ensuite je mets cette formule en macro pour automatiser.
 

Pièces jointes

  • TEST1.xlsm
    73.6 KB · Affichages: 1

Discussions similaires

Statistiques des forums

Discussions
311 733
Messages
2 082 019
Membres
101 872
dernier inscrit
Colin T