Comparer des doublons et trouver les différences

Bonjour,

voici un petit casse tête qui me préoccupe depuis un moment.

Ci-joint un fichier exemple.

Sur la feuille "Genotypage_brut" j'ai un tableau contenant des individus en colonne A ayant des valeurs associées à des marqueurs en colonnes F à AG.

Ces noms sont souvent en doublons avec des valeurs en théorie identiques, cependant il arrive qu'il y ait des erreurs.

Je souhaite pouvoir comparer les doublons entre eux, fusionner les valeurs identiques sur une nouvelle feuille et surligner les valeurs différentes sur une nouvelle feuille pour pouvoir les corriger.

Cette différence ne doit pas être indiquée si elle est due à un 0 mais bien à une différence entre 2 valeurs positives.

De plus mon tableau est parfaitement dynamique et extensible en lignes et colonnes.

L'idéal serait d'obtenir le résultat de la feuille "Bilan_genotypage".

Actuellement j'y arrive par le biais d'un tableau croisé dynamique qui donne les max et les min de chaque valeur/individus et je fais la soustraction des 2 pour obtenir les différences que je vais ensuite corriger manuellement (feuilles max/min/max-min).

Ceci étant assez fastidieux j'aimerai pouvoir passer automatiquement de la feuille "Genotypage_brut" à la version fusionnée et comparée de la feuille "bilan_genotypage".

J'espère avoir été assez clair, merci pour votre aide

J'ai pensé à une solution qui doit être réalisable, pour transférer mes données et fusionner les lignes doublons.

J'ai fait une macro pour créer sur la feuille "test_fusionne" un tableau au format final souhaité, avec les noms des individus sans tenir compte des doublons.

A priori je dois pouvoir résoudre mon problème en copiant les données de la feuille "Genotypage_brut" avec une fonction MATCH et avec des conditions ou gestion des erreurs particulières.

La fonction MATCH irait chercher les données de chaque individu, pour chaque marqueur de la ligne 2 colonne F à AG.

Les conditions ou la gestion des erreurs se ferait comme suivant:

si cellule de destination est vide alors on copie la valeur source(pas d'erreur)

si cellule de destination =0 alors on copie et donc remplace par la valeur source

si cellule de destination =valeur identique à la valeur source alors on ne copie pas la valeur source ou on copie (le plus simple...)

si cellule de destination =valeur >0 et différente de la valeur source alors on concatene les 2 valeurs et on colorie la cellule en jaune.

Comment faire ce transfert de données avec conditions?

J'ai mis mon fichier exemple à jour pour simplifier...

Merci

Vraiment personne pour me décoincer?

Devant le peu d'entrain que suscite mon problème, je vous avoue vous avoir fait des infidélités avec un autre forum

Bref, voici la solution proposée que j'ai légèrement adaptée et qui semble fonctionner à merveille:

Sub copie_tableau()

Dim plagemarker As Range
Dim Cel As Range, plage As Range
Dim Sfile As Collection
Dim i As Long
Sheets("test_fusionne").Range("A3").CurrentRegion.Clear
With Sheets("Genotypage_brut")
    .Range("F1", Cells(2, Range("IV2").End(xlToLeft).Column)).Copy Sheets("test_fusionne").Range("B1")
    Set listeNoms = CreateObject("Scripting.Dictionary") 
    Set plage = Sheets("Genotypage_brut").Range("A3", Range("A65536").End(xlUp)) 

    For Each Cel In plage
        listeNoms(Cel.Value) = 0 
    Next Cel
    Sheets("test_fusionne").Range("A3").Resize(listeNoms.Count, 1) = Application.Transpose(listeNoms.keys)

    For marker = 6 To .Range("IV2").End(xlToLeft).Column 
        Set listeMarkers = CreateObject("Scripting.Dictionary")
        For Each k In listeNoms.keys
            For lig = 3 To .Cells(65536, marker).End(xlUp).Row
                If .Cells(lig, marker) <> 0 Then
                    If .Cells(lig, 1) = k Then listeMarkers(.Cells(lig, marker).Value) = ""
                End If
            Next lig
            ligneNom = Application.Match(k, Sheets("test_fusionne").Range("A1", Sheets("test_fusionne").Range("A65536").End(xlUp)), 0)
            Sheets("test_fusionne").Cells(ligneNom, marker - 4) = Join(listeMarkers.keys, "#")

            listeMarkers.RemoveAll
        Next k
    Next marker

    listeNoms.RemoveAll
End With

Sheets("test_fusionne").Activate
Sheets("test_fusionne").Range(Range("A3", Range("A65536").End(xlUp)), Cells(2, Range("IV2").End(xlToLeft).Column).Offset(1, 0)).Select
For Each Cel In Selection
    If Cel.Value = "" Then Cel.Value = "0"
    If InStr(1, Cel.Value, "#") > 0 Then Cel.Interior.ColorIndex = 6
    Next Cel
    If Selection.Find("#") > 0 Then MsgBox "Vous avez des différences de lectures"

End Sub

Au final, on créé un nouveau tableau sur une feuille et on fusionne les lignes en doublons en conservant et surlignant les différences éventuelles.

Si ça peut servir à quelqu'un d'autre....