Déterminer nom Eleveur en fonction de son matricule

Bonjour à tous,

Tout d’abord, je tiens à renouveler mes remerciements aux anciens intervenants pour mes antécédentes demandes.

Cette fois-ci, ma demande concerne les traitements des caractères, je m’explique :

Tous les caractères se trouvant avant le caractère "-" (Tiret) dans toutes les cellules de la colonne "A", représente le matricule de l’éleveur et me donne finalement le nom de l’éleveur, voir le 1er exemple de la 2e cellule de la colonne "A" en A2.

Si je consulte cette cellule A2, son contenu est : TOU27-001/2006 M, on remarque qu’à gauche du caractère "-", on retrouve les caractères suivants : "TOU27", cela veut dire qu’il s’agit de l’éleveur: "Roland W". Pour avoir plus de détails sur les autres éleveurs, consulter ma pièce jointe.

Je vous informe que j’ai déjà écrit un petit code qui répond à ma demande, il fonctionne mais il n’est pas assez rapide. Il faut dire que ma base de données est beaucoup plus importante que les données dans la pièce jointe et c’est pour cela que je vous demande de me proposer une variante qui soit plus rapide que la mienne, en utilisant pourquoi pas un dictionnaire ou Arrays, voir peut-être la combinaison des deux.

Je reste à votre disposition pour d’autres informations supplémentaires.

Cordiale poignée de mains.

7eleveur.xlsm (20.02 Ko)

bonjour,

dans les colonnes M:N, il y a un tableau structuré avec ces abbrev. et leur noms (à completer encore). Avec une formule simple, on connaît l'éle

9eleveur.xlsm (54.52 Ko)

veur.

Bonjour BsAlv et le forum,

Merci pour votre réponse.

Il y’a 2 erreurs qui se sont glissés dans le code du module que j’ai colorié en "Brun" et que j’ai corrigé dans le code qui se trouve plus bas :

If Left(Cells(i, 1), 5) = "MDG14" Or Left(Cells(i, 1), 4) = "CH14" Or Left(Cells(i, 1), 3) = "478" Then Cells(i, 4) = "Parmoz G"

If Left(Cells(i, 1), 5) = "MDG29" Or Left(Cells(i, 1), 4) = "CH29" Then Cells(i, 4) = "Lirodeau A"

If Left(Cells(i, 1), 5) = "MDG15" Then Cells(i, 4) = "Abtamedo T"

If Left(Cells(i, 1), 5) = "TOU17" Then Cells(i, 4) = "Soroy E"

If Left(Cells(i, 1), 5) = "MBC35" Or Left(Cells(i, 1), 3) = "235" Then Cells(i, 4) = "Dalicorp L"

If Left(Cells(i, 1), 5) = "MBC96" Or Left(Cells(i, 1), 3) = "896" Then Cells(i, 4) = "Mankialigo N"

If Left(Cells(i, 1), 3) = "856" Or Left(Cells(i, 1), 2) = "S2" Then Cells(i, 4) = "Mays Jan"

If Left(Cells(i, 1), 3) = "838" Then Cells(i, 4) = "Nysisten J"

If Left(Cells(i, 1), 5) = "TOU27" Or Left(Cells(i, 1), 3) = "C27" Or Left(Cells(i, 1), 3) = "C27" Or Left(Cells(i, 1), 4) = "CT27" Then Cells(i, 4) = "Roland W"

If Left(Cells(i, 1), 5) = "TOU03" Or Left(Cells(i, 1), 3) = "CT3" Then Cells(i, 4) = "Cardinato F"

If Left(Cells(i, 1), 3) = "S2" Then Cells(i, 4) = "Lagerdriso R"

If Left(Cells(i, 1), 5) = "MDG66" Then Cells(i, 4) = "Hanazett J"

Je l'ai modifié comme suit, voir la modification en couleur Bleu :

If Left(Cells(i, 1), 5) = "MDG14" Or Left(Cells(i, 1), 4) = "CH14" Or Left(Cells(i, 1), 3) = "478" Then Cells(i, 4) = "Parmoz G"

If Left(Cells(i, 1), 5) = "MDG29" Or Left(Cells(i, 1), 4) = "CH29" Then Cells(i, 4) = "Lirodeau A"

If Left(Cells(i, 1), 5) = "MDG15" Then Cells(i, 4) = "Abtamedo T"

If Left(Cells(i, 1), 5) = "TOU17" Then Cells(i, 4) = "Soroy E"

If Left(Cells(i, 1), 5) = "MBC35" Or Left(Cells(i, 1), 3) = "235" Then Cells(i, 4) = "Dalicorp L"

If Left(Cells(i, 1), 5) = "MBC96" Or Left(Cells(i, 1), 3) = "896" Then Cells(i, 4) = "Mankialigo N"

If Left(Cells(i, 1), 3) = "856" Or Left(Cells(i, 1), 2) = "S2" Then Cells(i, 4) = "Mays Jan"

If Left(Cells(i, 1), 3) = "838" Then Cells(i, 4) = "Nysisten J"

If Left(Cells(i, 1), 5) = "TOU27" Or Left(Cells(i, 1), 3) = "C27" Or Left(Cells(i, 1), 4) = "CT27" Then Cells(i, 4) = "Roland W"

If Left(Cells(i, 1), 5) = "TOU03" Or Left(Cells(i, 1), 3) = "CT3" Then Cells(i, 4) = "Cardinato F"

If Left(Cells(i, 1), 3) = "LS2" Then Cells(i, 4) = "Lagerdriso R"

If Left(Cells(i, 1), 5) = "MDG66" Then Cells(i, 4) = "Hanazett J"

J’ai complété le tableau structuré avec tous les matricules possibles et leurs noms correspondants, malgré tout, dans certaines cellules le mot « erreur » figure. Pourtant la formule devrait m’afficher un résultat autre que l’erreur.

Je me permets d’ajouter que mes résultats finaux qui se trouvent dans mon tableau, sont manipulées de plusieurs manières.

J’ai peur et je crains que le fait d’avoir des formules risque de m’handicaper lors de la manipulation de ces données entre mes feuilles, d’où ma demande d’une solution en vba.

Je sais que le fait d’avoir mes résultats en format texte, me facilite et me permet une manipulation facile et sans trop de problèmes.

Salutations amicales.

bonjour Harzer,

vous préférez la solution avec une formule ou avec VBA ? Avec VBA, il faut limiter l'accès vers la feuille (lire& écrire). Voici cette macro à part modifiée

Sub Eleveur()

     Dim Arr, aOut, i, j
     t = Timer

     Arr = Range("A1").CurrentRegion.Offset(1).Value2     'lire le contenu de votre plage (dynamique) sauf l'entête
     ReDim aOut(1 To UBound(Arr), 1 To 1)     'sauvegarder temporairement les résultat dans cette matrice

     For i = 1 To UBound(Arr)     'boucle les données
          j = InStr(1, Arr(i, 1), "-")     'position du "-"
          If j > 0 Then     'il y a un "-" dans ce string ?
               Select Case UCase(Left(Arr(i, 1), j))     'code de l'éleveur + "-"

     '*******************************************************************************
     'methode :
     '- après le "Case", on a une liste de tous les codes (en majuscules et avec ce "-" comme dernier charactère)
     '- puis un double point et le nom de l'éleveur après le "s="
     ' DONC :        Case " CODE1","CODE2","CODE3":s="éleveur"
     '*******************************************************************************
                    Case "MDG14-", "CH14-", "478-": s = "Parmoz G"
                    Case "MDG29-", "CH29-": s = "Lirodeau A"
                    Case "MDG15-": s = "Abtamedo T"
                    Case "TOU17-": s = "Soroy E"
                    Case "MBC35-", "235-": s = "Dalicorp L"
                    Case "MBC96-", "896-": s = "Mankialigo N"
     ' If Left(Cells(i, 1), 3) = "856" Or Left(Cells(i, 1), 2) = "S2" Then Cells(i, 4) = "Mays Jan"
     ' If Left(Cells(i, 1), 3) = "838" Then Cells(i, 4) = "Nysisten J"
                    Case "TOU27-", "C27-", "CT27-": s = "Roland W"
     ' If Left(Cells(i, 1), 5) = "TOU03" Or Left(Cells(i, 1), 3) = "CT3" Then Cells(i, 4) = "Cardinato F"
     ' If Left(Cells(i, 1), 3) = "S2" Then Cells(i, 4) = "Lagerdriso R"
     ' If Left(Cells(i, 1), 5) = "MDG66" Then Cells(i, 4) = "Hanazett J"
     ' Je l     'ai modifié comme suit, voir la modification en couleur Bleu :
     ' If Left(Cells(i, 1), 5) = "MDG14" Or Left(Cells(i, 1), 4) = "CH14" Or Left(Cells(i, 1), 3) = "478" Then Cells(i, 4) = "Parmoz G"
     ' If Left(Cells(i, 1), 5) = "MDG29" Or Left(Cells(i, 1), 4) = "CH29" Then Cells(i, 4) = "Lirodeau A"
     ' If Left(Cells(i, 1), 5) = "MDG15" Then Cells(i, 4) = "Abtamedo T"
     ' If Left(Cells(i, 1), 5) = "TOU17" Then Cells(i, 4) = "Soroy E"
     ' If Left(Cells(i, 1), 5) = "MBC35" Or Left(Cells(i, 1), 3) = "235" Then Cells(i, 4) = "Dalicorp L"
     ' If Left(Cells(i, 1), 5) = "MBC96" Or Left(Cells(i, 1), 3) = "896" Then Cells(i, 4) = "Mankialigo N"
     ' If Left(Cells(i, 1), 3) = "856" Or Left(Cells(i, 1), 2) = "S2" Then Cells(i, 4) = "Mays Jan"
     ' If Left(Cells(i, 1), 3) = "838" Then Cells(i, 4) = "Nysisten J"
     ' If Left(Cells(i, 1), 5) = "TOU27" Or Left(Cells(i, 1), 3) = "C27" Or Left(Cells(i, 1), 4) = "CT27" Then Cells(i, 4) = "Roland W"
     ' If Left(Cells(i, 1), 5) = "TOU03" Or Left(Cells(i, 1), 3) = "CT3" Then Cells(i, 4) = "Cardinato F"
     ' If Left(Cells(i, 1), 3) = "LS2" Then Cells(i, 4) = "Lagerdriso R"
     ' If Left(Cells(i, 1), 5) = "MDG66" Then Cells(i, 4) = "Hanazett J"
               End Select
               aOut(i, 1) = s 'écrire le résultat dans la matrice au lieu de la feuille (vitesse !!!)
          End If
     Next i

     Range("D2").Resize(UBound(aOut)).Value = aOut 'finallement écrire tout en 1 fois !!!
MsgBox "prêt en " & Format(Timer - t, "0.00\s")
End Sub
3eleveur.xlsm (26.88 Ko)

pour les erreurs avec la formule, j'ai besoin de votre dernier fichier ...

Bonjour

Les données feuil1 ont été converti en tableau structuré

j'utilise la fonction Split et select case

ATTENTION! il y a 2 S2....

4eleveur-v1.xlsm (21.37 Ko)

A+ François

Bonjour BsAlv et fanfan38,

Merci à tous les deux pour vos propositions respectives, elles fonctionnent et me donne le bon résultat.

Je réponds en premier à fanfan38 en lui disant que c’est bien vu pour la remarque concernant la répétition du "S2", je l’avais remarqué aussi par après et je l’ai mentionné dans mon précèdent message.

Maintenant je réponds à BsAlv en lui disant merci pour sa 2e proposition en vba, elle est rapide et me satisfait totalement.

Cordiale poignée de mains à tous les deux.

Bonjour à tous,

pour moi il faut faire un tableau éleveur sur une feuille annexe et ne pas mettre en dur dans le code.
Plus facile à faire évoluer.
Plus que très rapide normalement
Liste feuille Param à compléter...
eric

5eleveur.xlsm (23.87 Ko)

@Eriiic, c'était ma reponse de hier 20:18

Arf, désolé.

J'ai bien ouvert le fichier de fanfan38 mais pour toi je me suis contenté du dernier code mis à 8:24 pour me faire une idée...
eric

Bonjour eriiic, BsAlv, fanfan38 & les autres membres

Mon 1ere message s’adresse à eriiic pour lui dire, Merci pour votre réponse et la solution proposée, l’exécution du code est rapide et me donne le résultat souhaité. Bravo.

Maintenant, je m’adresse à tous les participants à ma demande :

Quel plaisir d’avoir autant de personne qui se consacrent aux autres, partagent leurs savoir et sont disponibles gracieusement. Tout mon Respect Messieurs.

Cordiale poignée de mains à tous.

Bonjour eriic,

Pouvez-vous SVP commenter votre code, celà me permettera à comprendre la totalité du votre code.

D'avance merci.

Bonjour,

voilà

Sub eleveur()
    Dim jeune, eleveur(), tEleveur, crit, tmp
    Dim Dlig   As Long, i As Long, j As Long, k As Long, ok As Boolean

    Dlig = Range("A" & Rows.Count).End(xlUp).Row   'Dlig = dernière ligne colonne "A"
    tEleveur = Range("T_eleveur").Value ' on récupère le tableau des éleveurs dans une variable pour n'avoir qu'une seule lecture
    jeune = [A2].Resize(Dlig - 1).Value ' idem pour les jeunes
    ReDim eleveur(1 To UBound(jeune), 1 To 1) ' on taille le tableau de l'éleveur des jeunes pour n'avoir qu'une seule écriture à la fin -> colonne D

    For i = 1 To UBound(jeune)
        'pour chaque jeune
        ok = False ' éleveur non trouvé
        For j = 1 To UBound(tEleveur)
            ' pour chaque éleveur
            tmp = Split(tEleveur(j, 2), ";") ' chaines repère éleveur découpées dans un tableau
            For k = 0 To UBound(tmp)
                ' pour chaque chaine repère
                ' on check le début de la chaine jeune
                If Left(jeune(i, 1), Len(tmp(k))) = tmp(k) Then ok = True: Exit For ' si ok on sort
            Next k
            If ok Then eleveur(i, 1) = tEleveur(j, 1): Exit For ' si ok on inscrit l'éleveur sur sa ligne et on sort
        Next j
    Next i ' jeune suivant
    ' écriture résultat
    [D2].Resize(UBound(eleveur)).Value = eleveur
End Sub

eric

Bonsoir eriiic,

Merci pour votre message avec le code commenté.

Les commentaires aident beaucoup mieux la compréhension du code surtout pour des débutants comme moi.

Salutations Amicales.

Rechercher des sujets similaires à "determiner nom eleveur fonction matricule"