Choix sur seconde feuille

Bonjour

Voici mon problème et je ne sais pas comment m'en dépêtrer.

J'ai une première feuille "commande" avec une saisie manuelle du nombre de pièce commandées par personne (voir fichier ci-joint), avec seulement les trois dernières colonnes en calcul automatique.

Seulement, je voudrais savoir si il est possible sur la seconde feuille "montage" de ne récupérer que les lignes dont les résultats sont rouge (dans la feuille "commande) pour en déduire un tableau de montage.

Je pense que cela n'est pas très claire alors n'hésitez pas a poser des questions!!!!

Lien du fichier
http://we.tl/yDoGQn65Eg

3 réponses

  1. Contributeur
    Bonjour
    une proposition ici, sous réserve de compréhension.La solutionne fait pas référence aux couleurs de cellules (c'est assez compliqué avec Excel) mais au fait que seuls les valeurs négatives sont à afficher selon ce que définit vos formules de MFC

    Ça reste toutefois à prouver, car vos empilages de conditions pour pour définir la couleur des cellules sont contradictoires
    (<0 ou <6 ????? en b;leu >-1 et en rouge <0 ?????))
    La solution se base sur un codage dans la colonne X de "Commande", colonne qui peut être masquée ou placée sur n'importe quelle autre feuille.
    revenez si cela ne convient pas

    https://www.cjoint.com/c/EAiogAcqkhN

    crdlmnt
    0
    1. Modérateur
      Bonjour à tous
      Encore une autre façon de faire.. là aussi avec du VBA et en se basant sur les valeurs négatives.
      https://www.cjoint.com/?0AipkHH7wDJ

      Ici.. pas de afficher/masquer les lignes.... Il recréé complètement le tableau (sous-sections comprises) en parcourant (et ce.. peut importe le nombre) les lignes dans la feuille Commande...

      
      Sub test()
      Dim lastRCible As Long
      Dim lastRsrc As Long
      Dim Fsrc As Worksheet
      Dim Fcible As Worksheet
      Dim plageaTraiter As Range
      Dim rangeToMerge As Range
      
      Set Fsrc = Sheets("Commande")
      Set Fcible = Sheets("Montage")
      
      
      lastRsrc = Fsrc.Cells.Find("*", Range("B2"), , , xlByRows, xlPrevious).Row + 1
      Set plageaTraiter = Fsrc.Range("B3:M" & lastRsrc)
      For Each R In plageaTraiter.Rows
       Debug.Print "------>> Ligne : " & R.Row
       
        'on récupère le titre des sections
        If Fsrc.Cells(R.Row, "B").MergeCells Then
        Debug.Print "Cellules fusionnées.. donc.. sous section !"
          'la cellule est fusionnée..cela correspond à une "sous section"
          'recherche de la première ligne vide dans la feuille de destination
          lastRCible = Fcible.Cells.Find("*", Range("B6"), , , xlByRows, xlPrevious).Row + 1
          Set rangeToMerge = Range(Fcible.Cells(lastRCible, "B"), Fcible.Cells(lastRCible, "F"))
          With rangeToMerge
              .HorizontalAlignment = xlCenter
              .VerticalAlignment = xlBottom
              .WrapText = False
              .Orientation = 0
              .AddIndent = False
              .IndentLevel = 0
              .ShrinkToFit = False
              .ReadingOrder = xlContext
              .MergeCells = False
          End With
          rangeToMerge.Merge
          With rangeToMerge.Interior
              .Pattern = xlSolid
              .PatternColorIndex = xlAutomatic
              .ThemeColor = xlThemeColorDark1
              .TintAndShade = -0.149998474074526
              .PatternTintAndShade = 0
          End With
          rangeToMerge.Font.Bold = True
          Fcible.Cells(lastRCible, "B").Value = Fsrc.Cells(R.Row, "B").Value
        End If
       
       If Fsrc.Cells(R.Row, "M").Value < 0 Then
          Debug.Print "La cellule est négative ! => " & Cells(R.Row, "M").Value
          'recherche de la première ligne vide dans la feuille de destination
          lastRCible = Fcible.Cells.Find("*", Range("B6"), , , xlByRows, xlPrevious).Row + 1
          Fcible.Cells(lastRCible, "B").Value = Fsrc.Cells(R.Row, "B").Value
          Fcible.Cells(lastRCible, "C").Value = Fsrc.Cells(R.Row, "K").Value
          Fcible.Cells(lastRCible, "D").Value = Fsrc.Cells(R.Row, "L").Value
          Fcible.Cells(lastRCible, "E").Value = Fsrc.Cells(R.Row, "M").Value
          Fcible.Cells(lastRCible, "F").FormulaLocal = "=C" & lastRCible & "-D" & lastRCible
          End If
      
      Next
      
      
      End Sub
      


      PS: Il reste des petites choses à ajouter.. comme le fait de mettre des bordure autour du tableau et de la couleur dans les cellules...
      Tu peux aussi ajouter une "remise à zéro" du tableau avant de relancer la macro histoire de ne pas "ajouter" des lignes en doublon...
      Mais bon.. ça n'est qu'un exemple de ce qui est faisable.

      EDIT : Pour le RAZ du tableau de l'onglet Commande.. tu peux faire ceci
      Sub RAZtblCommande()
      Dim Fcible As Worksheet
      Dim lastRCible As Long
      Set Fcible = Sheets("Montage")
      lastRCible = Fcible.Cells.Find("*", Range("B6"), , , xlByRows, xlPrevious).Row + 1
      Rows(7 & ":" & lastRCible).Delete
      End Sub
      


      et le lancer dans la précédente sub ( Sub test() ) via un
       Call  RAZtblCommande() 


      Cordialement,
      Jordane
      0