Identifier série

[Adriano43]

Bonjour à toutes et à tous,

Me voilà confronté à un nouveau problème devant lequel j'ai le raisonnement sur papier mais n'arrive pas à le transcrire efficacement en VBA.
Concrétement, je souhaite que la macro recherche la valeur minimale de la colonne J pour les cellules "nombres non nulles" et me restitue par la suite la série des 5 plus petites valeurs rangées par ordre croissant en m'indiquant la valeur correspondante contenue en colonne K.

Ex: série en valeur 20;30;40;50;60 correspondant en colonne K à A,B,C,D,E
résultat à afficher par la macro : A - B - C - D - E
Ci-joint un fichier exemple

Cordialement

Adriano

 

[Efgé]

Re : Identifier série

Bonjour Adriano43
Une proposition avec ce que j'ai compris.
Coridialement

 

[Adriano43]

Re : Identifier série

Bonjour Efgé,

Merci de vous être attardé sur mon problème. Vous avez bien compris mon explication. Cependant je souhaiterais apporter 1 modifications:
- serait il possible d'incrémenter "les valeurs d'un lot" dès lors que l'un d'entre elles est incluse dans la série?
ex: Dans votre fichier, on constate que la série est C - D - C - D- A. Alors qu'en réalité, cela devrait être C-D-A-C-D
Cela revient à réinitialiser un lot en totalité dès que l'une des valeurs est dans la série.

 

[Efgé]

Re : Identifier série

Re
Je suis désolé mais je n'ai Rien compris 😀
Tu peux récapépéter tout depuis le bédut ?
Cordialement

 

[Adriano43]

Re : Identifier série

Re,

C'est complexe je sais!!!....
Je voudrais que :

Dès qu'une valeur est dans la série (cette valeur appartient à une famille A ou B ou C ou D...); je voudrais que toutes les valeurs de cette famille soit incrémentée de la valeur qui a été incluse dans la série.

Deuxième interrogation car j'envisage cette piste, serait-il possible d'appliquer la macro uniquement aux lignes surlignées en gris?

 

[Efgé]

Re : Identifier série

Re
Pour "appliquer la macro uniquement aux cellules surlignées en gris", il faut que la cellule du dessus porte la lettre à récupérer. (voir exemple)
Pour le reste je ne vois pas comment faire....
Cordialement

 

[Adriano43]

Re : Identifier série

Ok merci, je vais regarder.
Mais par contre pourriez vous m'expliquer un phénomène étrange:
Sur le véritable, les infos se trouvent en colonne 17 et 18, je modifie votre macro mais celle ci ne s'éxécute pas, la ligne suivante est surlignée en jaune:

If .Cells(i, 17).Value > 0 And .Cells(i, 18).Value <> "" Then

 

[Efgé]

Re : Identifier série

Re
Il faut adapter la ligne précédente:

With Sheets("Feuil1")

Si ta feuille ne s'appelle pas Feuil1, VBA n'aime pas.
Cordialement

EDIT*
Ou tu as oublié d'ajouter le retour à la ligne " _" ( espace + _).

 

[Adriano43]

Re : Identifier série

Mais je l'ai bien adapaté, mais cela vient pas de là...

 

[Efgé]

Re : Identifier série

Re
Poste une copie du code qui ne vas pas
Cordialement

 

[Adriano43]

Re : Identifier série

L'erreur a changé, il me dit "Next sans for" alors que je n'ai pas touché le reste du code.

Public Sub prctest()

    Dim i&, D As Object, T As Variant, Msg$
    Set D = CreateObject("Scripting.Dictionary")
    
    With Sheets("BDD")
    For i = 2 To .Cells(Rows.Count, 17).End(xlUp).Row
        If .Cells(i, 17).Value > 0 And .Cells(i, 18).Value <> "" Then
            D(.Cells(i, 17).Value) = .Cells(i, 18).Value
    Next i
    End With
    T = D.Keys
    Call prctri(T, LBound(T), UBound(T))
    ReDim Preserve T(1 To 6)
    For i = 1 To 6
    'T(i) = Valeur en colonne Q
    'D(T(i)) = Lettre en colonne R
    Msg = Msg & T(i) & vbTab & vbTab & D(T(i)) & vbLf
    Next i
    MsgBox Msg, 64, "Compte rendu"

End Sub

 

[Efgé]

Re : Identifier série

Re
J'avais éditer mon post, nous nous sommes croisé.
Tu as oublié d'ajouter le retour à la ligne " _" ( espace + _).

 If .Cells(i, 17).Value > 0 And .Cells(i, 18).Value  "" Then _
            D(.Cells(i, 17).Value) = .Cells(i, 18).Value

Cela permet de ne pas utiliser de End IF
Comme tu ne le mets pas, VBA attend le End IF et te dis qu'il y a une erreur de boucle.
Cordialement

 

[Adriano43]

Re : Identifier série

Re,

L'erreur ne vient pas de là, puisque j'ai entre temps tout mis sur la même ligne mais il bugue toujours...
Au niveau du next i ... Vraiment désolé

Public Sub prctournee()

    Dim i&, D As Object, T As Variant, Msg$
    Set D = CreateObject("Scripting.Dictionary")
    'T(i) = Valeur en colonne Q
    'D(T(i)) = Lettre en colonne R
    
    With Sheets("BDD")
    For i = 2 To .Cells(Rows.Count, 17).End(xlUp).Row
        If .Cells(i, 17).Value > 0 And .Cells(i, 18).Value <> "" Then D(.Cells(i, 17).Value) = .Cells(i, 18).Value
    Next i
    End With
    T = D.Keys
    Call prctri(T, LBound(T), UBound(T))
    ReDim Preserve T(1 To 6)
    For i = 1 To 6
    Msg = Msg & T(i) & vbTab & vbTab & D(T(i)) & vbLf
    Next i
    MsgBox Msg, 64, "Organisation"

End Sub

 

[Efgé]

Re : Identifier série

Re
J'ai mis ton code tel quel dans ton exemple.
J'ai modifié le quicksort en conséquence de son nouveau nom (tu aurais pu garder son nom en respect pour l"auteur..)
Tout fonctionne.
Vérifi tes données et colonnes.
Je ne peux pas t'en dire plus.
Cordialement

 

[Adriano43]

Re : Identifier série

Re,

Je comprends pas à quoi vous faites allusion en parlant de "quicksort"??