Pb tableau pour classer et ordonner

Mondelain

XLDnaute Nouveau
Bonjour,
J ai effectué un tableau avec des équipes, des numeros de postes, avec des prises de poissons avec totaux, moyenne et classement. Ça tout va bien.
Maintenant, je voudrais extraire de ce tableau d autres résultats.
Faire un classement du plus gros poisson péché parmi tout les poids et tue les équipes qui serait classe comme suit.
Poste/equipe/poids/classement.
Merci pour votre aide
 

Pièces jointes

  • IMG_20180522_164846.jpg
    IMG_20180522_164846.jpg
    3.1 MB · Affichages: 101

bcharef

XLDnaute Accro
Bonjour Mondelain
Bonjour à toutes et à tous.

Bienvenue parmi nous.

Il était souhaitable de joindre un fichier Excel au lieu d'image d'une part, et, d'autre part d'afficher les objectifs attendus.

Voici un essai, si j'ai bien compris la difficulté rencontrée.

Salutations distinguées.
 

Pièces jointes

  • Mondelain.xlsx
    16.7 KB · Affichages: 34

job75

XLDnaute Barbatruc
Bonjour Mondelain, bonjour bcharef, heureux de te retrouver :)

Voyez le fichier joint et cette macro dans le code de la feuille (clic droit sur l'onglet et Visualiser le code) :
Code:
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
With [D10:AG40] 'à adapter
    If Intersect(Target, .Cells) Is Nothing Or Target(1) = "" Then Exit Sub
    Dim a, d$, c As Range, maxC, ligC&, maxM, ligM&
    Cancel = True
    '---format nombre personnalisé---
    a = [{"","C";"C","M";"M",""}]
    d = Right(Target(1).Text, 1)
    If d <> "C" And d <> "M" Then d = ""
    d = Application.VLookup(d, a, 2, 0) 'rotation
    Target.NumberFormat = "0.00 """ & d & """"
    '---poids total C et M---
    ReDim a(1 To 2)
    For Each c In Intersect(Target(1).EntireRow, .Cells)
        If c.Text Like "*C" Then a(1) = a(1) + c
        If c.Text Like "*M" Then a(2) = a(2) + c
    Next
    Intersect(Target(1).EntireRow, [AL:AM]) = a
    '---plus gros poisson C et M---
    For Each c In .Cells
        If c.Text Like "*C" Then If c > maxC Then maxC = c: ligC = c.Row
        If c.Text Like "*M" Then If c > maxM Then maxM = c: ligM = c.Row
    Next
    With [A45:AG46] 'à adapter
        .Resize(, .Columns.Count + 1) = "" 'RAZ
        If ligC Then .EntireColumn.Rows(ligC).Copy .Cells(1): .Cells(1, .Columns.Count + 1) = maxC
        If ligM Then .EntireColumn.Rows(ligM).Copy .Cells(2, 1): .Cells(2, .Columns.Count + 1) = maxM
        .Resize(, .Columns.Count + 1).Borders.Weight = xlThin 'bordures
    End With
End With
End Sub
Le double-clic dans la plage D10:AG40 entraîne les calculs des 3 opérations indiquées.

Noter la rotation des formats personnalisés.

A+
 

Pièces jointes

  • tableau essai(1).xlsm
    35.1 KB · Affichages: 29

bcharef

XLDnaute Accro
Rebonjour Modelain;
Rebonjour à toutes et à tous.

Voici un essai réalisé avec des formules matricielles à valider par Ctrl+Maj+Entrée ainsi que des plages nommées.

Salutations distinguées.

Edit
Bonjour Monsieur Job, le plaisir est partagé
 

Pièces jointes

  • ModelainV02.xlsx
    22.4 KB · Affichages: 28

Mondelain

XLDnaute Nouveau
Bonjour,
tout d'abord un grand merci a vous deux pour votre travail, deux méthodes deux tableau différents, chapeau bas messieurs.
cependant, Monsieur job, j'ai du mal a finaliser le tableau afin que toutes les cases fonctionnes, je n'arrive pas a affecter la macron a l'ensemble des cellules??? de plus dans les colonnes poids communes et poids miroir c'est le poids total commune et miroir en AL et AM .

Monsieur Bcharef, merci merci beaucoup, au top , juste un truc, dans le tableau appelé "classement plus gros poisson" doit y avoir uniquement 3 lignes .
37 ---> poste / equipe/ sponsors/ en AH37 prise de la plus grosse commune ex: 41.26c/ classement
38---> poste/ equipe / sponsors / en AH38 prise de la plus grosse miroir ex: 48.23m / classement
pas de 3eme ligne.

bien vu aussi la colonne pour controler si erreur, vraiment au top.

Pouvez vous voire si on peut modifier juste ces petits points??

merci encore a vous

bien cordialement
 

bcharef

XLDnaute Accro
Bonsoir Modelain & Job75,
Bonsoir à toutes et à tous.

Afin de bien comprendre votre difficulté, veuillez adapter vos objectifs attendus par rapport aux données réelles du présent fichier.

Dans l'attente de vous lire.

Salutations distinguées.
 

Mondelain

XLDnaute Nouveau
Re bonsoir a vous,

on va y arriver mais pas évident comme ca
- dans la cellule AH37 --> uniquement la plus grosse prise "m" de tte la zone et non le cumul des poids en prise "m"
- - dans la cellule AH38 --> uniquement la plus grosse prise "c" de tte la zone et non le cumul des poids en prise "c"
dans ce tableau sera indiqué l'équipe qui aura péché la plus grosse prise "m" et l'équipe qui aura péché la plus grosse prise "c" et non le cumul...

salutation
 

Pièces jointes

  • ModelainV03 a modifier.xlsx
    23.1 KB · Affichages: 26

job75

XLDnaute Barbatruc
Bonjour Mondelain, bcharef, le forum,
Monsieur job, j'ai du mal a finaliser le tableau afin que toutes les cases fonctionnes, je n'arrive pas a affecter la macron a l'ensemble des cellules??? de plus dans les colonnes poids communes et poids miroir c'est le poids total commune et miroir en AL et AM .
Je ne vois pas ce que vous voulez dire, il suffit dans le code d'adapter les 2 plages D10:AG40 et A45:AG46.

Et en colonnes AL et AM c'est bien la somme des C et M, vous n'avez pas testé les doubles-clics !!!

Cela dit si l'on fait du copier-coller ou des effacements dans la plage D10:AG40 le double-clic ne suffit pas, il faut une Worksheet_Change :
Code:
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
With [D10:AG40] 'à adapter
    If Intersect(Target, .Cells) Is Nothing Or Target(1) = "" Then Exit Sub
    Dim a, d$
    Cancel = True
    '---format nombre personnalisé---
    a = [{"","C";"C","M";"M",""}]
    d = Right(Target(1).Text, 1)
    If d <> "C" And d <> "M" Then d = ""
    d = Application.VLookup(d, a, 2, 0) 'rotation
    Target.NumberFormat = "0.00 """ & d & """"
    '---poids total et plus gros poisson---
    Worksheet_Change Target 'lance la macro
End With
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
Dim r As Range, a, c As Range, maxC, ligC&, maxM, ligM&
Application.EnableEvents = False 'désactive les évènements
With [D10:AG40] 'à adapter
    '---poids total C et M---
    Set r = Intersect(Target.EntireRow, .Cells)
    If Not r Is Nothing Then
        For Each r In r.Rows 'si entrées/effacements multiples
            ReDim a(1 To 2)
            For Each c In r.Cells
                If c Like "*C" Or c Like "*M" Then c = "" 'sécurité
                If c.Text Like "*C" Then a(1) = a(1) + c
                If c.Text Like "*M" Then a(2) = a(2) + c
            Next c
            Intersect(r.EntireRow, [AL:AM]) = a
        Next r
    End If
    '---plus gros poisson C et M---
    For Each c In .Cells
        If c.Text Like "*C" Then If c > maxC Then maxC = c: ligC = c.Row
        If c.Text Like "*M" Then If c > maxM Then maxM = c: ligM = c.Row
    Next
    With [A45:AG46] 'à adapter
        .Resize(, .Columns.Count + 1) = "" 'RAZ
        If ligC Then .EntireColumn.Rows(ligC).Copy .Cells(1): .Cells(1, .Columns.Count + 1) = maxC
        If ligM Then .EntireColumn.Rows(ligM).Copy .Cells(2, 1): .Cells(2, .Columns.Count + 1) = maxM
        .Resize(, .Columns.Count + 1).Borders.Weight = xlThin 'bordures
    End With
End With
Application.EnableEvents = True 'réactive les évènements
End Sub

Edit 1 : notez que les résultats en AL et AM et en A45:AH46 ne peuvent pas être modifiés manuellement.

Edit 2 : j'espère aussi que vous avez vu - et compris - les formules des colonnes AH à AK.

Fichier (2).

Bonne journée.
 

Pièces jointes

  • tableau essai(2).xlsm
    36.8 KB · Affichages: 25
Dernière édition:

Mondelain

XLDnaute Nouveau
Rebonsoir Modelain & Job75,
ReBonsoir à toutes et à tous.

Un autre essai.

Salutations

Bonjour bcharef,

Encore merci pour votre détermination, je vous ai notifier une problématique sur le dernier tableau.
Effectivement l'équipe ne correspond pas au poids sur le petit tableau ...
vous verrez j'ai notifier des codes couleurs..



merci encore

yannick
 

Pièces jointes

  • ModelainV04 a modifier.xlsx
    22.4 KB · Affichages: 28

Discussions similaires

Réponses
8
Affichages
884
Membre supprimé 341069
M

Statistiques des forums

Discussions
311 720
Messages
2 081 917
Membres
101 839
dernier inscrit
laurentEstrées