Travailler sur un pourcentage de nombre de lignes trouvée suivant criteres
Bonjour,
Je souhaiterai pour un nombre de ligne trouvés dans un tableau suivant des critères, les compter totalement et pour un certain pourcentage de ligne totale trouvées inscrire une valeur.
Pour exemple :
Pour un total de 100 lignes trouvées suivant critères dans un tableau de 1000 lignes, je souhaiterai :
=> Inscrire une valeur "X" dans la cellule en fin de ligne pour 20% des 100 lignes soit 20 lignes avec la dernière cellule avec la valeur en question "X".
=> Inscrire une valeur "Y" dans la cellule en fin de ligne pour 40% des 100 lignes soit 40 lignes avec la dernière cellule avec la valeur en question "Y".
=> Inscrire une valeur "Z" dans la cellule en fin de ligne pour 40% des 100 lignes soit 40 lignes avec la dernière cellule avec la valeur en question "Z".
Merci d'avance pour l'aide apportée.
bonjour,
une proposition à appliquer sur ta sélection, sans doute à adapter à ton fichier...
Sub aargh()
With ActiveSheet 'feuille active
dl = .Cells(Rows.Count, 1).End(xlUp).Row 'nombre de lignes
dc = .Cells(1, Columns.Count).End(xlToLeft).Column + 1 ' dernière colonne +1 = où placer la letter x,y ou Z
For i = 1 To dl 'on parcourt toutes les lignes de la première à la dernière
pct = (i) / dl 'calcul du pourcentage correspondant à la ligne
Select Case pct
Case Is <= 0.2 '20%
v = "X"
Case Is <= 0.6 '40% suivants
v = "Y"
Case Is <= 1 '40% suivants
v = "Z"
End Select
.Cells(i, dc) = v
Next i
End With
End Subbonjour H2SO4, Adrian66, le fil,
l'idée est que vous filtrez le tableau selon vos critères et puis 2 colonnes à droite du tableau les lignes visibles recoivent un X, Y ou Z.
Sub Teste()
Dim r, r0, r1
With Sheets("Blad1").Range("A1").ListObject
.DataBodyRange.Resize(, 1).Offset(, .ListColumns.Count + 1).ClearContents 'RAZ 2 colonnes vers droit du tableau
r = .ListColumns(1).Range.SpecialCells(xlVisible).Count - 1 'le nombre de lignes visible
If r > 0 Then
.ListColumns(1).DataBodyRange.SpecialCells(xlVisible).Offset(, 2).value = "Z" 'mettez un "Z" dans toutes ces cellules visible
r0 = r
For i = .ListRows.Count To 1 Step -1 'dans un boucle
r1 = .ListColumns(1).DataBodyRange.Resize(i).SpecialCells(xlVisible).Count 'compter le nombre de lignes visible
If Not b1 And r1 <= r * 0.6 Then b1 = True: .ListColumns(1).DataBodyRange.Resize(i).SpecialCells(xlVisible).Offset(, 2).value = "Y" 'maintenant juste egal ou en dessous 60%
If Not b2 And r1 <= r * 0.2 Then .ListColumns(1).DataBodyRange.Resize(i).SpecialCells(xlVisible).Offset(, 2).value = "X": Exit For 'maintenant juste egal ou en dessous 20%
r0 = r
Next
End If
End With
End Subun petit peut plus court, de nouveau avec un autofilter qui ne montre que les lignes intéressantes.
Sub Teste()
Dim r, r20, r60
With Sheets("Blad1").Range("A1").ListObject
Set c = .DataBodyRange.Resize(, 1).Offset(, .ListColumns.Count + 1) 'cette plage pour les X, Y et Z
c.ClearContents 'RAZ 2 colonnes vers droit du tableau
r = .ListColumns(1).Range.SpecialCells(xlVisible).Count - 1 'le nombre de lignes visible
If r > 0 Then
.ListColumns(1).DataBodyRange.SpecialCells(xlVisible).Offset(, 2).FormulaR1C1 = "=row()" 'inscrire le numéro de la ligne dans ces cellules visible
r60 = Application.WorksheetFunction.Aggregate(15, 7, c, r * 0.6) 'numéro de la ligne de la valeur à 60% (percentile) = 20%+40%
r20 = Application.WorksheetFunction.Aggregate(15, 7, c, r * 0.2) 'numéro de la ligne de la valeur à 20% (percentile)
c.SpecialCells(xlVisible).value = "Z" 'toutes les cellules
c.Resize(r60 - c.row + 1).SpecialCells(xlVisible).value = "Y" 'les 60%
c.Resize(r20 - c.row + 1).SpecialCells(xlVisible).value = "X" 'les 20%
End If
End With
End SubEDIT : c'était "+1" au lieu de "-1" ...
Bonjour,
Merci pour vos réponses, cependant, c'est un bon début mais je n'arrive pas a aller jusqu'au bout de mon objectif, je vais essayer d'être plus précis :
En gros voici mon tableau ci-dessous "onglet Lignes", le but étant de positionner la bonne lettre dans la colonne pourcentage :
Pour se faire j'ai cette base dans un autre Onglet "Pourcentage" :
L'objectif étant de remplir dans le premier onglet la colonne pourcentage avec les lettres suivant les pourcentages affichés dans l'onglet 2 :
En gros dans le premier onglet, pour le département 1 j'ai 7 chats, je dois donc remplir 3 lignes avec la lettre A (40%) , 3 lignes avec la lettre B (40%) et 1 lignes avec la lettre C (20%).....
Je dois systématiquement pour REMPLIR le tableau aller voir le département et pour un même animal compter le nombre de ligne et y associer les lettre suivant le pourcentage associé au nombre de ligne (deuxième onglet)....
En espérant avoir été clair.
Merci,
bonjour Adrian66,
Oui, c'est clair. Vous avez un fichier que vous pouvez partager ?
Voici le fichier que j'ai construit en TEST
re,
Bonjour à tous !
Une approche via Power Query :
Merci beaucoup tout fonctionne nickel, par contre une question si je rajoute un ou plusieurs pourcentages supplémentaire genre D => 30% et E=> 20% (en sachant que la ligne entiere des pourcentage sera égal à 100%) j'ai juste a rajouter ces lignes en questions :
If i1 > 0 Then
r1 = Application.Min(cDBR.Rows.Count + cRng.Row, Application.WorksheetFunction.Aggregate(15, 7, cAux, i1)) 'seulement partie 1 et 2
cDBR.Resize(r1 - cRng.Row).SpecialCells(xlVisible).Value = aA(i, 13)
i1 = Int(0.5 + r * aA(i, 9))
If i1 > 0 Then
r1 = Application.Min(cDBR.Rows.Count + cRng.Row, Application.WorksheetFunction.Aggregate(15, 7, cAux, i1)) 'seulement partie 1
cDBR.Resize(r1 - cRng.Row).SpecialCells(xlVisible).Value = aA(i, 8)
End If
Cdlt,
Bonjour à tous !
Dans la proposition Power Query, une mise à jour du tableau structuré (t_Pour100) et un simple "Actualiser tout", vous retournera le résultat....
bonjour JFL, Adrian66, le fil,
@JFL, quand je lis votre proposition, c'est facile, mais je ne suis pas capable à le reproduire tout seul ...
Bonjour à tous !
Etrange affaire....
J'ai rencontré des soucis de...... tableaux structurés ! La propagation ne se déroulait pas automatiquement.
Sans modifier la requête, j'obtiens ceci :
