Partage
  • Partager sur Facebook
  • Partager sur Twitter

Boucle sur Macro excel VBA

Sujet résolu
    23 novembre 2021 à 10:22:07

    Bonjour,

    je débute sur les macros excel, j'ai réalisé une macro en m'appuyant sur des morceaux de code que j'ai récupéré.

    J'ai une liste d'article avec des prévisions de vente en colonne (par mois), il faut que je dépli tout cela en ligne, en ajoutant des informations fixes.
    J'arrive à obtenir le résultat que je souhaite mais je ne sais pas comment répéter le processus pour chaque ligne de mon tableau d'origine.
    J'imagine bien qu'il faut insérer des compteurs avec des +1 mais je suis perdu.

    Voici mon tableau pour test :

    01/07/2022 01/08/2022 01/09/2022 01/10/2022 01/11/2022 01/12/2022
    66125 1 755 1 284 2 687 1 851 1 654

    2 192

    66115 813 713 853 821 757 693

    Voici le résultat que j'obtiens :

    Nom N° article Date prévision Qté Code u Qté par unit Quantité (base) Code m composant Désig N° séq
    GLOBAL 66125 01/07/2022 1 755 UNITE 1 1 755 D false   0
    GLOBAL 66125 01/08/2022 1 284 UNITE 1 1 284 D false   0
    GLOBAL 66125 01/09/2022 2 687 UNITE 1 2 687 D false   0
    GLOBAL 66125 01/10/2022 1 851 UNITE 1 1 851 D false   0
    GLOBAL 66125 01/11/2022 1 654 UNITE 1 1 654 D false   0
    GLOBAL 66125 01/12/2022 2 192 UNITE 1 2 192 D false   0

    Voici ma macro :

    Sub Macro1()
    '
    ' Macro1 Macro
    '
    
    '   Sélection liste article
    
        Sheets.Add After:=ActiveSheet
        ActiveSheet.Name = "Sheet2"
    
        Sheets("Feuil1").Select
        Range("A2").Select
        Selection.Copy
        
        Sheets("Sheet2").Select
        Range("A1:A6").Select
        ActiveSheet.Paste
        
    '   Sélection Date
    
        Application.CutCopyMode = False
        Sheets("Feuil1").Select
        Range("B1:G1").Select
        Selection.Copy
        Sheets("Sheet2").Select
        Range("D1").Select
        ActiveSheet.Paste
        Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
            :=False, Transpose:=False
        Rows("1:1").Select
        Application.CutCopyMode = False
        Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
        Sheets("Sheet2").Select
        
        Range("D2:I2").Select
        Selection.Copy
        Range("B2").Select
        Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
        False, Transpose:=True
        
        Columns("D:I").Select
        Selection.Delete Shift:=xlToLeft
        Rows("1:1").Select
        Selection.Delete Shift:=xlUp
    
    '   Sélection prévisions 1
        
        Application.CutCopyMode = False
        Sheets("Feuil1").Select
        Range("B2:G2").Select
        Selection.Copy
        Sheets("Sheet2").Select
        Range("D1").Select
        ActiveSheet.Paste
        Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
            :=False, Transpose:=False
        Rows("1:1").Select
        Application.CutCopyMode = False
        Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
        Sheets("Sheet2").Select
        
        Range("D2:I2").Select
        Selection.Copy
        Range("C2").Select
        Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
        False, Transpose:=True
        
        Columns("D:I").Select
        Selection.Delete Shift:=xlToLeft
        Rows("1:1").Select
        Selection.Delete Shift:=xlUp
        
    '   Sélection prévisions 2
        
        Application.CutCopyMode = False
        Sheets("Feuil1").Select
        Range("B2:G2").Select
        Selection.Copy
        Sheets("Sheet2").Select
        Range("L1").Select
        ActiveSheet.Paste
        Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
            :=False, Transpose:=False
        Rows("1:1").Select
        Application.CutCopyMode = False
        Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
        Sheets("Sheet2").Select
        
        Range("L2:Q2").Select
        Selection.Copy
        Range("F2").Select
        Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
        False, Transpose:=True
    
        Columns("L:Q").Select
        Selection.Delete Shift:=xlToLeft
        Rows("1:1").Select
        Selection.Delete Shift:=xlUp
    
    ' Mise en forme 1
        Sheets("Sheet2").Select
        
        Columns("A:A").Select
        Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
        Range("A1").Select
        ActiveCell.FormulaR1C1 = "GLOBAL"
        Selection.Copy
        Range(Selection, Selection.End(xlDown)).Select
        ActiveSheet.Paste
        
    
        Range("E1").Select
        ActiveCell.FormulaR1C1 = "UNITE"
        Range("F1").Select
        ActiveCell.FormulaR1C1 = "1"
        Range("E1:F1").Select
        Selection.Copy
        Range(Selection, Selection.End(xlDown)).Select
        ActiveSheet.Paste
        
    
        Range("H1").Select
        ActiveCell.FormulaR1C1 = "D"
        Range("I1").Select
        ActiveCell.FormulaR1C1 = "'false"
        Range("K1").Select
        ActiveCell.FormulaR1C1 = "0"
        Range("H1:K1").Select
        Selection.Copy
        Range(Selection, Selection.End(xlDown)).Select
        ActiveSheet.Paste
        End Sub
    
    


    Merci d'avance de toute l'aide que vous pourrez m'apporter.

    • Partager sur Facebook
    • Partager sur Twitter
      23 novembre 2021 à 13:17:03

      Que c'est moche le code généré automatiquement par l'enregistrement de macro :D mais bon, ça peut aider.

      Sinon c'est quoi la relation entre les colonnes Qté, Qté par unit, et Quantité(base) ?  

      par exemple

      si Qté = 120, et Qté par unit =10 alors Quantié(base) = 12 ? 

      si Qté = 125, et Qté par unit =10 alors Quantié(base) = 13 ? 

      Option Explicit
      
      Sub macro_tableau()
          Dim Tableau1 As Range
          Dim Feuil1 As Worksheet, Feuil2 As Worksheet
          
          Set Feuil1 = ThisWorkbook.Sheets("Feuil1")
          Set Feuil2 = ThisWorkbook.Sheets("Feuil2") '' Feuil2 doit être créer à la main pour le moment
          Set Tableau1 = Feuil1.Range(Feuil1.Cells(2, 1), Feuil1.Cells(2, 1).End(xlDown).End(xlToRight))
          //on définit les colonnes du tableau 2
          Const col_Nom = 1
          Const col_Article = 2
          Const col_DatePrev = 3
          Const col_Qte = 4
          Const col_CodeU = 5
          Const col_QteParUnite = 6
          Const col_QteBase = 7
          Const col_CodeM = 8
          Const col_Composant = 9
          Const col_Desig = 10
          Const col_NSeq = 12
          
          Dim ligne As Range
          Dim cell As Range
          Dim ligne_t2 As Long
          Dim col_t1 As Long
      
          // initialise le nom des colonnes
          Feuil2.Cells(1, col_Nom).Value = "Nom"
          Feuil2.Cells(1, col_Article).Value = "N° Article"
          Feuil2.Cells(1, col_DatePrev).Value = "Date Prévision"
          Feuil2.Cells(1, col_Qte).Value = "Qté"
          Feuil2.Cells(1, col_CodeU).Value = "Code u"
          Feuil2.Cells(1, col_QteParUnite).Value = "Qté par unit"
          Feuil2.Cells(1, col_QteBase).Value = "Quantité(Base)"
          Feuil2.Cells(1, col_CodeM).Value = "Code m"
          Feuil2.Cells(1, col_Composant).Value = "Composant"
          Feuil2.Cells(1, col_Desig).Value = "Desig"
          Feuil2.Cells(1, col_NSeq).Value = "N° Seq"
          ligne_t2 = 2
      
          For Each ligne In Tableau1.Rows
              For col_t1 = 2 To ligne.Columns.Count
                  Feuil2.Cells(ligne_t2, col_Article).Value = Feuil1.Cells(ligne.Row, 1).Value
                  Feuil2.Cells(ligne_t2, col_DatePrev).Value = Feuil1.Cells(1, col_t1).Value
                  Feuil2.Cells(ligne_t2, col_Qte).Value = Feuil1.Cells(ligne.Row, col_t1).Value
                  Feuil2.Cells(ligne_t2, col_Nom).Value = "GLOBAL"
                  Feuil2.Cells(ligne_t2, col_CodeU).Value = "UNITE"
                  Feuil2.Cells(ligne_t2, col_QteParUnite).Value = "1"
                  Feuil2.Cells(ligne_t2, col_QteBase).Formula = "=ROUNDUP(" & Feuil2.Cells(ligne_t2, col_Qte).Address & "/" & Feuil2.Cells(ligne_t2, col_QteParUnite).Address & ",0)"
                  Feuil2.Cells(ligne_t2, col_CodeM).Value = "D"
                  Feuil2.Cells(ligne_t2, col_Composant).Value = "false"
                  Feuil2.Cells(ligne_t2, col_Desig).Value = ""
                  Feuil2.Cells(ligne_t2, col_NSeq).Value = "0"
                  ligne_t2 = ligne_t2 + 1
              Next col_t1
          Next ligne
      End Sub
      



      -
      Edité par umfred 23 novembre 2021 à 13:30:08

      • Partager sur Facebook
      • Partager sur Twitter
        23 novembre 2021 à 14:51:13

        Concernant les colonnes quantités :
        Qté est toujours = à Quantité (base)
        Qté par unit est toujours = 1
        Ce sont des valeurs que je dois rentrer pour importer ensuite, et ces valeurs sont constantes.

               
        • Partager sur Facebook
        • Partager sur Twitter
          23 novembre 2021 à 15:02:52

          dans ce cas, ma ligne 50 devient

          Feuil2.Cells(ligne_t2, col_QteBase).value = Feuil2.Cells(ligne_t2, col_Qte).Value



          • Partager sur Facebook
          • Partager sur Twitter
            23 novembre 2021 à 15:39:45

            Si je comprends bien

            .Formula = "=ROUNDUP(" & Feuil2.Cells(ligne_t2, col_Qte).Address & "/" & Feuil2.Cells(ligne_t2, col_QteParUnite)

            c'était le calcul sur lequel s'appliquait aussi un arrondi.

            J'ai gardé ceci pour la ligne 50 :

            Feuil2.Cells(ligne_t2, col_QteBase).Formula = "=ROUND(" & Feuil2.Cells(ligne_t2, col_Qte).Address & ",0)"

            Je comprends que pour la ligne 50 l'arrondi s'applique sur la valeur de la ligne 46. Mais je n'arrive pas à faire l'arrondi directement sur la ligne 46.
            En tout cas, merci, c'est déjà super !
            J'ai essayé ceci et je crois que ça marche

            Feuil2.Cells(ligne_t2, col_Qte).Formula = "=ROUND(" & Feuil1.Cells(ligne.Row, col_t1) & ",0)"

            -
            Edité par Sh_K 23 novembre 2021 à 15:50:52

            • Partager sur Facebook
            • Partager sur Twitter
              24 novembre 2021 à 11:47:03

              un arrondi sur une quantité entière, je ne vois pas trop l'intérêt o_O
              • Partager sur Facebook
              • Partager sur Twitter
                26 novembre 2021 à 9:50:35

                En réalité les valeurs dans mon tableau excel ont des chiffres après la virgule, mais ils n'étaient pas affichés lorsque j'ai posté.
                Merci beaucoup.
                • Partager sur Facebook
                • Partager sur Twitter

                Boucle sur Macro excel VBA

                × Après avoir cliqué sur "Répondre" vous serez invité à vous connecter pour que votre message soit publié.
                • Editeur
                • Markdown