Recherche d'ancetre commun
Bonjour
Je suis bergere.
Pour mon travail je dispose d'un logiciel d’élevage où sont rentrées les informations concernant le père et la mère de chaque brebis.
Afin de limité je risque de croisement consanguin j'ai extrait les donné de ce logiciel sur excel.
Je me suis servi de fonction recherchev (que je maitrise assez bien) afin de trouver pour chaque animal ses grand parents et arrière grand parents.
Maintenant j'aimerai que ressorte (de préférence en couleur, sinon grâce a un message) les ancêtres commun.
Pour le coup je sèche!
Pourtant je fait régulièrement des fichiers pour m'aider dans ma gestion.
Mon objectif final se serait de pouvoir mettre en évidence quel femelle ne doit pas être mise avec quel male.
Mais pour le moment je ne vois pas comment (a part simuler les croisements des brebis avec nos 16 béliers reproducteur!)
J’espère que vous pourrez m'aider et que ca me permettra de decouvrir d'autre fonctionnalité que je ne maitrise pas encore!
Je vous met une infime partie de ma base de donnée (qui contient plus de 5000 betes)
Bonjour,
une solution avec une macro événementielle. faire un double-clic sur une ligne pour afficher en rouge les consanguinités.
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
dl = Cells(Rows.Count, 1).End(xlUp).Row
sexe = Cells(Target.Row, 3)
Cells.Interior.Pattern = xlNone
Range(Cells(Target.Row, 1), Cells(Target.Row, 21)).Interior.Color = vbYellow
For col = 8 To 21
Set re = Range("H2:U" & dl).Find(Cells(Target.Row, col), lookat:=xlWhole)
If Not re Is Nothing Then
fa = re.Address
Do
If sexe <> Cells(re.Row, 3) And re.Row <> Target.Row Then
re.Interior.Color = vbRed
End If
Set re = Range("H2:U" & dl).FindNext(re)
Loop Until re Is Nothing Or re.Address = fa
End If
Next col
End Sub