[ RESOLU ] Classer les plus grosses valeurs negatives,et

Guido

Guido

XLDnaute Accro
Bonsoir Le furum

J'aimerais faire ressortir les valeurs negatives et positives separement dans deux colonnes et

les classer de la plus grosses negative a la plus petites et classer les plus grosses valeurs positives a

la plus petite sans les valeurs ZERO

Merci

Guido
 

Pièces jointes

  • Classer plus grosses valeurs negatives,et.xls
    19.5 KB · Affichages: 85
  • Classer plus grosses valeurs negatives,et.xls
    19.5 KB · Affichages: 75
Trier par date Trier par votes
CISCO

CISCO

XLDnaute Barbatruc
Re : Classer les plus grosses valeurs negatives,et

Bonsoir

Cf. en pièce jointe. Formules matricielles dans les colonnes V et Y à valider avec Ctrl+maj+entrer. J'ai mis des formats personnalisés pour faire "disparaitre" les nombres en bas des colonnes W et Z.

@ plus
 

Pièces jointes

  • Classer plus grosses valeurs negatives,et.xls
    53.5 KB · Affichages: 75
  • Classer plus grosses valeurs negatives,et.xls
    53.5 KB · Affichages: 85
Vote positif 0 Vote négatif
Guido

Guido

XLDnaute Accro
Re : Classer les plus grosses valeurs negatives,et

Re CISCO

Merci pour ta reponse,

J'ai oublié de preciser que la donnée peut atteindre 20 valeurs parfois.

Voir le fichier ,merci pour corriger la formule

Guido
 

Pièces jointes

  • 362891d1461879663-classer-les-plus-grosses-valeurs-negatives-et-classer-plus-grosses-valeurs-neg.xls
    48 KB · Affichages: 76
Vote positif 0 Vote négatif
job75

job75

XLDnaute Barbatruc
Re : Classer les plus grosses valeurs negatives,et

Bonjour Guido, CISCO,

Code: 
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Dim P1 As Range, P2 As Range
If Intersect(Target, [B3,K3]) Is Nothing Then Exit Sub 'cellules à adapter
Cancel = True
Application.ScreenUpdating = False
If Me.FilterMode Then Me.ShowAllData 'si la feuille est filtrée
With Range(Target, Target(Rows.Count - Target.Row + 1, 2).End(xlUp))
  Set P1 = .Offset(, 3): Set P2 = .Offset(, 6)
  .Copy P1: .Copy P2
End With
P1.Sort P1(1, 2), xlAscending, Header:=xlYes 'tri
P1.AutoFilter 2, ">=0" 'filtre automatique
Set P1 = P1.Offset(1).SpecialCells(xlCellTypeVisible)
P1.Clear: P1.Interior.ColorIndex = 2 'couleur blanche facultative...
Me.AutoFilterMode = False
P2.Sort P2(1, 2), xlDescending, Header:=xlYes 'tri
P2.AutoFilter 2, "<=0" 'filtre automatique
Set P2 = P2.Offset(1).SpecialCells(xlCellTypeVisible)
P2.Clear: P2.Interior.ColorIndex = 2 'couleur blanche facultative...
Me.AutoFilterMode = False
End Sub
Fichier joint.

A+
 

Pièces jointes

  • Classer plus grosses valeurs negatives et positives(1).xls
    31.5 KB · Affichages: 83
Vote positif 0 Vote négatif
job75

job75

XLDnaute Barbatruc
Re : Classer les plus grosses valeurs negatives,et

Re,

En cas de cellules vides :

Code: 
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Dim P1 As Range, P2 As Range
If Intersect(Target, [B3,K3]) Is Nothing Then Exit Sub 'cellules à adapter
Cancel = True
Application.ScreenUpdating = False
If Me.FilterMode Then Me.ShowAllData 'si la feuille est filtrée
With Range(Target, Target(Rows.Count - Target.Row + 1, 2).End(xlUp))
  Set P1 = .Offset(, 3): Set P2 = .Offset(, 6)
  .Copy P1: .Copy P2
End With
P1.Sort P1(1, 2), xlAscending, Header:=xlYes 'tri
P1.Columns(2).Replace "", 0 'en cas de cellules vides
P1.AutoFilter 2, ">=0" 'filtre automatique
Set P1 = P1.Offset(1).SpecialCells(xlCellTypeVisible)
P1.Clear: P1.Interior.ColorIndex = 2 'couleur blanche facultative...
Me.AutoFilterMode = False
P2.Sort P2(1, 2), xlDescending, Header:=xlYes 'tri
P2.Columns(2).Replace "", 0 'en cas de cellules vides
P2.AutoFilter 2, "<=0" 'filtre automatique
Set P2 = P2.Offset(1).SpecialCells(xlCellTypeVisible)
P2.Clear: P2.Interior.ColorIndex = 2 'couleur blanche facultative...
Me.AutoFilterMode = False
End Sub
Fichier (2).

A+
 

Pièces jointes

  • Classer plus grosses valeurs negatives et positives(2).xls
    31.5 KB · Affichages: 77
Vote positif 0 Vote négatif
job75

job75

XLDnaute Barbatruc
Re : Classer les plus grosses valeurs negatives,et

Re,

Pour finir voici une meilleure solution avec filtrage par colonne auxiliaire.

Elle fonctionne même s'il y a des cellules vides, des valeurs textes ou des valeurs d'erreur :

Code: 
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Dim P As Range
If Intersect(Target, [B3,K3]) Is Nothing Then Exit Sub 'cellules à adapter
Cancel = True
Application.ScreenUpdating = False
If Me.FilterMode Then Me.ShowAllData 'si la feuille est filtrée
With Range(Target, Target(Rows.Count - Target.Row + 1, 2).End(xlUp))
  Set P = .Offset(, 3): .Copy P: Filtrer P, ">0", xlAscending
  Set P = .Offset(, 6): .Copy P: Filtrer P, "<0", xlDescending
End With
End Sub

Sub Filtrer(P As Range, critere$, sens%)
With P.Offset(1).Columns(3) 'colonne auxiliaire
  .FormulaR1C1 = "=IF(ISNUMBER(1/(-(""""&RC[-1])" & critere & ")),RC[-1],"""")"
  .Value = .Value 'supprime les formules
  P.Resize(, 3).Sort .Cells, sens, Header:=xlYes 'tri
  Set P = Intersect(P.Offset(1), .SpecialCells(xlCellTypeBlanks).EntireRow)
  .ClearContents
End With
P.Clear: P.Interior.ColorIndex = 2 'couleur blanche facultative...
End Sub
Fichier (3).

A+
 

Pièces jointes

  • Classer plus grosses valeurs negatives et positives(3).xls
    44 KB · Affichages: 80
Vote positif 0 Vote négatif
job75

job75

XLDnaute Barbatruc
Re : Classer les plus grosses valeurs negatives,et

Re,

Bah pas besoin de colonne auxiliaire, ici les formules sont entrées dans la 2ème colonne :

Code: 
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Dim P As Range
If Intersect(Target, [B3,K3]) Is Nothing Then Exit Sub 'cellules à adapter
Cancel = True
Application.ScreenUpdating = False
If Me.FilterMode Then Me.ShowAllData 'si la feuille est filtrée
With Range(Target, Target(Rows.Count - Target.Row + 1, 2).End(xlUp))
  Set P = .Offset(, 3): .Copy P: Filtrer P, -3, ">0", xlAscending
  Set P = .Offset(, 6): .Copy P: Filtrer P, -6, "<0", xlDescending
End With
End Sub

Sub Filtrer(P As Range, decal%, critere$, sens%)
With P.Offset(1).Columns(2)
  .FormulaR1C1 = "=IF(ISNUMBER(1/(-(""""&RC[" & decal & "])" & critere & ")),RC[" & decal & "],"""")"
  .Value = .Value 'supprime les formules
  P.Sort .Cells, sens, Header:=xlYes 'tri
  Set P = Intersect(P.Offset(1), .SpecialCells(xlCellTypeBlanks).EntireRow)
End With
P.Clear: P.Interior.ColorIndex = 2 'couleur blanche facultative...
End Sub
Fichier (4).

Edit : pour mieux comprendre les formules insérez un End juste avant leur suppression :

Code: 
'----
  End
  .Value = .Value 'supprime les formules
A+
 

Pièces jointes

  • Classer plus grosses valeurs negatives et positives(4).xls
    42 KB · Affichages: 77
Dernière édition:
Vote positif 0 Vote négatif
job75

job75

XLDnaute Barbatruc
Re : Classer les plus grosses valeurs negatives,et

Bonjour Guido, CISCO, le forum,

Vous préfèrerez peut-être utiliser l'évènement Change :

Code: 
Private Sub Worksheet_Change(ByVal Target As Range)
Dim r As Range, P As Range
Set r = [B3,K3] '1ères cellules des tableaux, à adapter
For Each r In r
  With r.Resize(Rows.Count - r.Row + 1, 2)
    If Not Intersect(Target, .Cells) Is Nothing Then
      Application.ScreenUpdating = False
      If Me.FilterMode Then Me.ShowAllData 'si la feuille est filtrée
      Set P = .Offset(, 3): .Copy P: Filtrer P, -3, ">0", xlAscending
      Set P = .Offset(, 6): .Copy P: Filtrer P, -6, "<0", xlDescending
    End If
  End With
Next
End Sub

Sub Filtrer(P As Range, decal%, critere$, sens%)
Set P = Range(P(1), Cells(Rows.Count, P(1, 2).Column).End(xlUp))
With P.Offset(1).Columns(2)
  .FormulaR1C1 = "=IF(ISNUMBER(1/(-(""""&RC[" & decal & "])" & critere & ")),RC[" & decal & "],"""")"
  .Value = .Value 'supprime les formules
  P.Sort .Cells, sens, Header:=xlYes 'tri
  Set P = Intersect(P.Offset(1), .SpecialCells(xlCellTypeBlanks).EntireRow)
End With
P.Clear: P.Interior.ColorIndex = 2 'couleur blanche facultative...
End Sub
Fichier (5).

A+
 

Pièces jointes

  • Classer plus grosses valeurs negatives et positives(5).xls
    42 KB · Affichages: 75
Dernière édition:
Vote positif 0 Vote négatif
job75

job75

XLDnaute Barbatruc
Re : Classer les plus grosses valeurs negatives,et

Guido à dit:
J'ai oublié de preciser que la donnée peut atteindre 20 valeurs parfois.
Cliquez pour agrandir...

Si chaque tableau a au maximum 21 lignes c'est plus simple :

Code: 
Private Sub Worksheet_Change(ByVal Target As Range)
Dim r As Range, P As Range
Set r = [B3,K3] '1ères cellules des tableaux, à adapter
For Each r In r
  With r.Resize(21, 2) 'taille maximum d'un tableau
    If Not Intersect(Target, .Cells) Is Nothing Then
      Application.ScreenUpdating = False
      If Me.FilterMode Then Me.ShowAllData 'si la feuille est filtrée
      Set P = .Offset(, 3): .Copy P: Filtrer P, -3, ">0", xlAscending
      Set P = .Offset(, 6): .Copy P: Filtrer P, -6, "<0", xlDescending
    End If
  End With
Next
End Sub

Sub Filtrer(P As Range, decal%, critere$, sens%)
With P.Offset(1).Columns(2)
  .FormulaR1C1 = "=IF(ISNUMBER(1/(-(""""&RC[" & decal & "])" & critere & ")),RC[" & decal & "],"""")"
  .Value = .Value 'supprime les formules
  P.Sort .Cells, sens, Header:=xlYes 'tri
  Set P = Intersect(P.Offset(1), .SpecialCells(xlCellTypeBlanks).EntireRow)
End With
P.Clear: P.Interior.ColorIndex = 2 'couleur blanche facultative...
End Sub
Fichier (5 bis).

A+
 

Pièces jointes

  • Classer plus grosses valeurs negatives et positives(5 bis).xls
    37 KB · Affichages: 68
Vote positif 0 Vote négatif
Guido

Guido

XLDnaute Accro
Re : Classer les plus grosses valeurs negatives,et

Bonjour job75, CISCO

Merci pour ses propositions

la derniere bloque ,quand je formules 20 possibilités differentes

Je vais poster une nv feuille que job75 connais deja...????

se seras plus simple ,et ca vas m'eviter de faire 9 tableaux...

a de suite

Merci

Guido
 
Vote positif 0 Vote négatif
Guido

Guido

XLDnaute Accro
Re : Classer les plus grosses valeurs negatives,et

Guido à dit:
Bonjour job75, CISCO

Merci pour ses propositions

la derniere bloque ,quand je formules 20 possibilités differentes

Je vais poster une nv feuille que job75 connais deja...????

se seras plus simple ,et ca vas m'eviter de faire 9 tableaux...

a de suite

Merci

Guido
Cliquez pour agrandir...

Re

Voici le fichier

Si cela pourrais se faire avec une macro...Merci et un bouton...

Merci

Guido
 

Pièces jointes

  • Classer selon le modele...V1.xls
    97 KB · Affichages: 69
Vote positif 0 Vote négatif
job75

job75

XLDnaute Barbatruc
Re : Classer les plus grosses valeurs negatives,et

Bonjour Guido, le forum,

Pourquoi ne pas avoir donné ce fichier dès le post #1 ? On aurait évité du travail !!!

La macro du bouton :

Code: 
Private Sub CommandButton1_Click()
Dim c As Range, i As Variant
Application.ScreenUpdating = False
For Each c In Intersect([B:B], Me.UsedRange.EntireRow)
  If c = "N°" Then
    c.Resize(21, 5).Copy c(1, 9)
    c.Resize(, 5).Copy c(22, 9) '2ème ligne de titres
    With c(1, 9).Resize(22, 5)
      For i = 2 To 21
        If .Cells(i, 5) = 0 Then .Cells(i, 1).Resize(, 5) = "": _
          .Cells(i, 1).Resize(, 5).Interior.ColorIndex = xlNone
      Next
      .Sort .Columns(5), xlAscending, Header:=xlYes '1er tri
      i = Application.Match(0, .Columns(5))
      If IsNumeric(i) Then .Cells(i + 1, 1).Resize(22 - i, 5) _
        .Sort .Columns(5), xlDescending, Header:=xlNo '2ème tri
    End With
  End If
Next
End Sub
Fichier joint.

Bonne journée.
 

Pièces jointes

  • Classer selon le modele(1).xls
    84.5 KB · Affichages: 75
Vote positif 0 Vote négatif

Discussions similaires

C
  • Résolu(e)
XL 2019 Améliorer Function MinMax et plus grande valeur
Réponses
11
Affichages
495
carlos
C
lestoiles1
  • Résolu(e)
XL 2013 Effacer le contenu si la valeur n'est pas entre 13000 90000 et copier les valeurs dupliqués
Réponses
8
Affichages
137
lestoiles1
lestoiles1
C
  • Question
XL 2019 Fonction personnalisé avec boucle à simplifier
Réponses
5
Affichages
307
carlos
C
C
  • Résolu(e)
XL 2019 Meilleure option suivant les valeurs
Réponses
7
Affichages
355
cotignac
C
G
  • Question
XL 2016 Axer des points sur les barres d'un graphique (graphique combiné)
Réponses
0
Affichages
185
Goffy
G
S
  • Résolu(e)
XL 2016 Comment classer des résultats avec attributs et couleurs et avoir la somme des classes sur une feuille Excel?
Réponses
6
Affichages
576
stuka
S
C
  • Question
XL 2019 Distribuer des équipes en poules selon force et établissement
Réponses
2
Affichages
182
carlos
C
E
  • Question
Microsoft 365 fenetre pop up sur carte
Réponses
3
Affichages
559
Bernard_XLD
Bernard_XLD
S
  • Résolu(e)
XL 2021 Extraire valeurs après caractère spécial ou numérique
2
Réponses
20
Affichages
1 K
R@chid
R@chid
N
  • Question
XL 2013 Calcul matriciel a 2 inconnues - valeurs negatives
2
Réponses
17
Affichages
2 K
job75
job75

Membres actuellement en ligne

10 membres et 88 invités.

Partager cette page

Tutos vidéos

Power Query : Ajouter des requêtes (Excel et Power BI)
Créez votre première fonction LAMBDA dans Excel en 3 étapes!
LAMBDA, l’arme secrète de Microsoft pour Excel !
Office Insider - Découvrez les nouveautés Excel avant tout le monde

Statistiques des forums

Discussions
314 207
Messages
2 107 274
Membres
109 791
dernier inscrit
frederic.perrier@hotmail.