XL 2010 FAIRE LISTE AUTOMATIQUE SUIVANT NOMBRES

mcj1997

XLDnaute Accro
Bonjour,

En PJ, problématique pour générer en automatique des listes suivant deux critères.

Merci d'avance,
 

Pièces jointes

  • LISTE AUTO - Copie.xlsx
    13.9 KB · Affichages: 25

job75

XLDnaute Barbatruc
On peut créer les lignes par exemple quand C11 est égale à C9 (arrondie à l'unité), voyez le fichier joint et cette macro :
VB:
Private Sub Worksheet_Change(ByVal Target As Range)
If Application.Round([C9], 0) <> [C11] Or Intersect(Target, [D7:AD7,C11]) Is Nothing Then Exit Sub
With [B:B].Find("", [B11], xlValues) '1ère cellule vide sous B11
    With .Resize(, 29)
        .Value = [B9:AD9].Value
        .Borders(xlEdgeBottom).Weight = xlMedium
    End With
    .Value = "PF " & .Row - [B11].Row
End With
End Sub
 

Pièces jointes

  • LISTE AUTO(1).xlsm
    19.6 KB · Affichages: 12
Dernière édition:

mcj1997

XLDnaute Accro
C9 représente la somme de la ligne 9 suivant les "x" mis sur ligne 7.
C9 est le total des catégories qui peut varier.
quant à C11 c'est le nombre maximum par ligne appelé portefeuille PTF dans mon exemple.
Ainsi autre exemple si C9 égal 259 et c11égal 50, nous aurons 5 lignes (5 portefeuilles avec 50 et 1 avec 9).
 

Dranreb

XLDnaute Barbatruc
Bonjour.
À tout hasard, essayez cette programmation dans le module de l'objet Worksheet représentant la feuille :
VB:
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
   Dim Total As Double, MaxPF As Double, NbLig As Long, RngLig As Range
   If Intersect(Target, [D7:AD7,C11,D12:AD1000], Target) Is Nothing Then Exit Sub
   Total = [C9].Value
   MaxPF = [C11].Value
   NbLig = Int(Total / MaxPF): If NbLig * MaxPF < Total Then NbLig = NbLig + 1
   Set RngLig = [B12:AD12].Resize(NbLig)
   Application.EnableEvents = False
   With RngLig.Offset(NbLig).Resize(1000)
      .Borders(xlEdgeBottom).LineStyle = xlNone
      .Borders(xlInsideHorizontal).LineStyle = xlNone
      .ClearContents: End With
   With RngLig.Borders(xlEdgeBottom): .LineStyle = xlContinuous: .Weight = xlMedium: End With
   With RngLig.Borders(xlInsideHorizontal): .LineStyle = xlContinuous: .Weight = xlThin: End With
   RngLig.Columns(2).Value = MaxPF
   RngLig.Rows(RngLig.Rows.Count).FormulaR1C1 = "=R9C-SUM(R12C:R[-1]C)"
   RngLig.Columns(1).FormulaR1C1 = "=""PF ""&ROW()-" & RngLig.Row - 1
   RngLig.Value = RngLig.Value
   Application.EnableEvents = True
   End Sub
J'ai supposé les conditions suivantes:
La macro s'exécute quand on modifie une cellule qui impliquerait un changement des lignes de portefeuilles, ce qui inclut un changement de valeur dans celles-ci même.
Elle modifie la dernière de ses lignes nécessaires de telle sorte que le total de chaque colonne soit égal à la cellule en ligne 9, tant pour la colonne TOTAL que pour les colonnes catN.
 

Dranreb

XLDnaute Barbatruc
J'ai ajouté une sécurité pour éviter un plantage, et veiller à ce qu'il y ait toujours au moins une ligne, quand on supprime tous les "x" en ligne 7 :
VB:
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
   Dim Total As Double, MaxPF As Double, NbLig As Long, RngLig As Range
   If Intersect(Target, [D7:AD7,C11,D12:AD1000], Target) Is Nothing Then Exit Sub
   Total = [C9].Value
   MaxPF = [C11].Value
   NbLig = Int(Total / MaxPF): If NbLig * MaxPF < Total Then NbLig = NbLig + 1
   If NbLig = 0 Then NbLig = 1
   Set RngLig = [B12:AD12].Resize(NbLig)
   Application.EnableEvents = False
   With RngLig.Offset(NbLig).Resize(1000)
      .Borders(xlEdgeBottom).LineStyle = xlNone
      .Borders(xlInsideHorizontal).LineStyle = xlNone
      .ClearContents: End With
   With RngLig.Borders(xlEdgeBottom): .LineStyle = xlContinuous: .Weight = xlMedium: End With
   With RngLig.Borders(xlInsideHorizontal): .LineStyle = xlContinuous: .Weight = xlThin: End With
   RngLig.Columns(2).Value = MaxPF
   If RngLig.Rows.Count > 1 Then
      RngLig.Rows(RngLig.Rows.Count).FormulaR1C1 = "=R9C-SUM(R12C:R[-1]C)"
   Else
      RngLig.Rows(1).FormulaR1C1 = "=R9C": End If
   RngLig.Columns(1).FormulaR1C1 = "=""PF ""&ROW()-" & RngLig.Row - 1
   RngLig.Value = RngLig.Value
   Application.EnableEvents = True
   End Sub
 

Dranreb

XLDnaute Barbatruc
Remarque: Je n'ai pas supposé que dans chaque ligne de portefeuille, le total des montants de D à AD devait être égal à celui en C
J'ai supposé déjà bien assez de choses face au peu de précisions du demandeur …
Mais qui sait, je vais peut être quand même m'amuser à essayer de faire en sorte que ce soit le cas …
 

mcj1997

XLDnaute Accro
Merci à tous les deux et grand bravo vous avez compris même si ce n'était pas facile à expliquer, j'aurai encore besoin, dans mon fichier joint en feuil 1 fonctionne avec votre macro et en feuil 2 ce dont j'ai besoin.

Merci d'avance,
 

Pièces jointes

  • LISTE AUTO V2.xlsm
    196 KB · Affichages: 11

Discussions similaires

Statistiques des forums

Discussions
312 298
Messages
2 086 979
Membres
103 419
dernier inscrit
mk29