Suprimer les 4 premiers et 4 derniers d'un classement...

[Guido]

Bonjour le Forum

je recherche une formulle pour eliminer les 4 premiers et 4 derniers d'un classement

voir le petit fichiers merci

Guido

 

[MK.]

Re : Suprimer les 4 premiers et 4 derniers d'un classement...

Bonsoir. Un exemple à travailler.Cordialement.

 

[DoubleZero]

Re : Suprimer les 4 premiers et 4 derniers d'un classement...

Bonjour, Guido, MK., le Forum,

Dans le fichier joint, une suggestion par macro.

A bientôt 🙂

 

[Guido]

Re : Suprimer les 4 premiers et 4 derniers d'un classement...

Bonjour MK DoubleZero

MK sur mon PC 2003 ca ne marche pas sur mon PC 2013 C'est ok

DoubleZero

Sur mon 1er fichier c'est tout OK

Peux tu SVP adaper ta macro sur ma nouvelle feuille en adaptant les valeurs..a la droite des chx .

Merci.d'avance

Guido

 

[MK.]

Re : Suprimer les 4 premiers et 4 derniers d'un classement...

Juste par correction (je vois que la solution vba semble acquise). Le correctif pour la version 2003

=SI(ESTERREUR(PETITE.VALEUR(DECALER(A$1;$H$1;;NBVAL(A:A)-2*$H$1);LIGNE()));"";PETITE.VALEUR(DECALER(A$1;$H$1;;NBVAL(A:A)-2*$H$1);LIGNE()))

(validation matricielle)

 

[MK.]

Re : Suprimer les 4 premiers et 4 derniers d'un classement...

Bonjour doublezéro, Guido le forum
Votre fichier sans macro (au cas où)

 

[DoubleZero]

Re : Suprimer les 4 premiers et 4 derniers d'un classement...

Re-bonjour,

...Sur mon 1er fichier c'est tout OK

Peux tu SVP adaper ta macro sur ma nouvelle feuille en adaptant les valeurs..a la droite des chx ...

A l'avenir, merci de bien vouloir joindre en #1 le véritable 🙄 fichier de travail.

Une nouvelle version en pièce jointe.

A bientôt 🙂

 

[job75]

Re : Suprimer les 4 premiers et 4 derniers d'un classement...

Bonjour Guido, MK., DoubleZero,

Ma contribution VBA pour le fichier du post #4 :

Sub Elimination()
Dim n, depart As Range, clasfinal As Range, deb As Range, fin As Range
n = 4 'modifiable
Set depart = [D11:F30] 'à adapter
Set clasfinal = [I11:K30] 'à adapter
clasfinal = "" 'RAZ
Set deb = depart(n + 1, 1)
Set fin = depart.Find("*", , xlValues, , xlByColumns, xlPrevious)
If fin Is Nothing Then Exit Sub
If fin(1 - n).Row >= deb.Row Then Range(deb, fin(1 - n)).Copy clasfinal(1)
End Sub

Bonne soirée.

 

[Guido]

Re : Suprimer les 4 premiers et 4 derniers d'un classement...

Bonsoir

MK.DoubleZero,job75

Merci pour vos propositions

Tout est OK pour moi.yessss

DoubleZero

A l'avenir, merci de bien vouloir joindre en #1 le véritable fichier de travail.

Une nouvelle version en pièce jointe

Oui,mais j'ai du coupé une feuille car le fichier est trop lourd..

Merci

Guido

 

[job75]

Re : Suprimer les 4 premiers et 4 derniers d'un classement...

Re,

Pour finir j'améliore ma macro :

Sub Elimination()
Dim n, depart As Range, clasfinal As Range, deb As Range, fin As Range
n = 4
Set depart = [D11:F30] 'à adapter
Set clasfinal = [I11:K30] 'à adapter
clasfinal = ""
Set deb = depart(n + 1, 1)
Set fin = depart.Find("*", , xlValues, , xlByRows, xlPrevious)
If Not fin Is Nothing Then If fin(1 - n).Row >= deb.Row Then _
  Range(deb, Intersect(fin(1 - n).EntireRow, depart)).Copy clasfinal(1)
End Sub

Bonne fin de soirée.

 

[job75]

Re : Suprimer les 4 premiers et 4 derniers d'un classement...

Bonjour le fil, le forum,

On peut utiliser cette macro évènementielle :

Private Sub Worksheet_Change(ByVal Target As Range)
Dim n, depart As Range, clasfinal As Range, deb As Range, fin As Range
n = 4 'modifiable
Set depart = [D11:F30] 'à adapter
If Intersect(Target, depart) Is Nothing Then Exit Sub
Set clasfinal = [I11:K30] 'à adapter
Application.ScreenUpdating = False
clasfinal = "" 'RAZ
Set deb = depart(n + 1, 1)
Set fin = depart.Find("*", , xlValues, , xlByRows, xlPrevious)
If Not fin Is Nothing Then If n < fin.Row Then If fin(1 - n).Row >= deb.Row Then _
  Range(deb, Intersect(fin(1 - n).EntireRow, depart)).Copy clasfinal(1)
End Sub

Fichier joint.

Bonne journée.

 

[job75]

Re : Suprimer les 4 premiers et 4 derniers d'un classement...

Re,

Maintenant voici une solution par formule très simple, formule unique en I11 à copier sur I11:K30 :

=SI(LIGNES(D$11:D11)>NBVAL($D$11:$D$30)-8;"";D15)

Fichier joint.

A+

 

[job75]

Re : Suprimer les 4 premiers et 4 derniers d'un classement...

Re,

J'ai simplifié la formule du post précédent.

Il est clair qu'avec une formule aussi simple VBA est bien inutile.

A+

 

[Guido]

Re : Suprimer les 4 premiers et 4 derniers d'un classement...

Re

Bonjour le Forum et job75

Merci pour la formule,c'est OK

amitiés

Guido

 

[job75]

Re : Suprimer les 4 premiers et 4 derniers d'un classement...

Bonjour Guido, le forum,

La dernière formule me plaît bien alors j'utilise son principe en VBA :

Private Sub Worksheet_Change(ByVal Target As Range)
Dim n, depart As Range, decalcolonnes%, a$, b&
n = 4 'modifiable
Set depart = [D11:F30] 'à adapter
decalcolonnes = 5 'à adapter, pour obtenir la colonne I
If Intersect(Target, depart) Is Nothing Then Exit Sub
a = depart.Address
b = Application.CountA(depart.Columns(1)) - 2 * n
With depart.Offset(, decalcolonnes)
  .FormulaArray = "=IF(ROW(" & a & ")-" & depart.Row - 1 _
    & ">" & b & ","""",OFFSET(" & a & "," & n & ",))"
  .Value = .Value 'supprime les formules
End With
End Sub

La formule est entrée matriciellement dans la plage I11:K30.

Fichier joint.

A+