[ RESOLU par JBARBE,ET Job75 ] J'aimerais classer les valeurs qui se trouvent entre 17 et 30 .

[Guido]

Bonjour le Forum

J'aimerais avoir le classement finale avec seulement les

valeurs supérieurs a 16

Voir le fichier avec les deux pages avant et après...

Merci d'avance pour votre aide

Guido

 

[Guido]

Re

Voici le fichier

Merci

Guido

 

[JBARBE]

Bonjour à tous, Bonjour Guido,
En cliquant sur le bouton "GO"
Bonne journée !

 

[Guido]

Bonjour JBARBE et Le Forum

Merci pour la solution des cœur et des Valeurs

Amitiés

Guido

 

[job75]

Bonjour Guido, JBARBE,

Une autre solution, avec en plus une mise en forme correcte de la feuille :

Sub AutreTest()
Application.ScreenUpdating = False
On Error Resume Next 'si pas de SpecialCells
With Sheets("TOUT 300% AFFICHAGE FINAL")
  .Range("A4:G" & .Rows.Count).Delete xlUp 'RAZ
  Sheets("TOUT 300% AFFICHAGE").[A4].CurrentRegion.Copy .[A4]
  With .[A4].CurrentRegion.Resize(, 8)
    .Columns(8) = "=1/(G4<>"""")"
    Intersect(.SpecialCells(xlCellTypeFormulas, 16).EntireRow, .Cells).Delete xlUp
    .Columns(8) = ""
  End With
  .Rows(.Cells.Find("*", , xlValues, , xlByRows, xlPrevious).Row + 2 & ":" & Rows.Count).Delete
  .UsedRange.SpecialCells(xlCellTypeBlanks).Interior.ColorIndex = 15 'gris
  .Activate
End With
End Sub

A+

 

[Guido]

Bonsoir le Forum ,Job75

Merci pour ta solution qui me convient aussi.

j'ai vraiment a faire a des Pros

Si ,je voulais attribués un nombres de point ou un mot selon les différentes valeurs

peut t'on me donner une formule que je pourrais adapter..??

Valeur 22 est plus Hyper-Base

Valeur 20 et 21 3 cœurs rouge

Valeur 18 et 19 2 cœurs rouge

Valeur 17 1 cœur

D'avance Merci

Amitiés

Guido

 

[JBARBE]

Re,
Peut-être ceci !
Bonne soirée !

 

[job75]

Re,

Avec la police Webdings on ne peut pas mélanger du texte symbolique et du texte normal.

Le texte symbolique est renvoyé par cette formule en G5 :

=SI(OU(B5="";E5="";E5<17);"";RECHERCHE(E5;{17."Y";18."YY";20."YYY";22."YYYY"}))

Ensuite la macro modifie la formule et le nom de la police:

Sub NouveauTest()
Application.ScreenUpdating = False
On Error Resume Next 'si pas de SpecialCells
With Sheets("TOUT 300% AFFICHAGE FINAL")
  .Range("A4:G" & .Rows.Count).Delete xlUp 'RAZ
  Sheets("TOUT 300% AFFICHAGE").[A4].CurrentRegion.Copy .[A4]
  With .[A4].CurrentRegion.Resize(, 8)
    .Columns(8) = "=1/(G4<>"""")"
    Intersect(.SpecialCells(xlCellTypeFormulas, 16).EntireRow, .Cells).Delete xlUp
    .Columns(8) = "=1/(G4<>""YYYY"")"
    With Intersect(.SpecialCells(xlCellTypeFormulas, 16).EntireRow, .Cells.Columns(7))
      .Replace "YYYY", "Hyper-Base" 'modifie la formule
      .Font.Name = "Arial" 'modifie le nom de la police
      .Columns.AutoFit'ajustement largeur
    End With
    .Columns(8) = ""
  End With
  .Rows(.Cells.Find("*", , xlValues, , xlByRows, xlPrevious).Row + 2 & ":" & Rows.Count).Delete
  .UsedRange.SpecialCells(xlCellTypeBlanks).Interior.ColorIndex = 15 'gris
  .Activate
End With
End Sub

Fichier (2).

Bonne nuit.

 

[Guido]

RE

JBARBE ,Job75

Merci pour Vos solutions.

Merci ,Ainsi je considère que le post est RESOLU

Amitiés

Guido