Fusionner les scores de 2 fichiers
Bonjour à tous
j'ai un probleme, et je n'ai aucune idée de la formule à utiliser, mon niveau utilisateur etant tres bas...
voici le sujet:
j'ai 2 fichiers qui sont identiques, parcontre le nombre de ligne et les données peuvent etre differents.
ces 2 fichiers representent les scores de participants avec leurs noms et un Identifiant
Le but est de fusionner ces 2 fichiers, afin d'avoir tous les resultats dans une seule feuille, et que cela soit ordonné par score.
mais je ne conserve que le plus gros score d'un meme identifiant. (exemple si l'ID 100001 est present dans le fichier1 et egalement dans le fichier2, je ne conserve que la ligne representant le plus grand score) aussi si un meme identifiant possede le meme score dans les 2 feuilles, je ne conserve qu'un des 2 scores.
en esperant m'etre correctement exprimé
merci de votre aide
bonjour,
une autre solution avec une macro
Sub aargh()
'fusion de 2 classeurs
Set ash = ActiveSheet
ash.Cells.Delete
'selection des fichiers
With Application.FileDialog(msoFileDialogFilePicker)
.AllowMultiSelect = True
.Title = "veuillez choisir les 2 fichiers à fusionner"
.Filters.Clear
.Filters.Add "Excel files", "*.XLS*"
If .Show = True Then
If .SelectedItems.Count <> 2 Then
MsgBox "veuillez sélectionner 2 fichiers"
Exit Sub
End If
Else
MsgBox "aucun fichier sélectionné"
Exit Sub
End If
Set wb1 = Workbooks.Open(.SelectedItems(1))
Set ws1 = wb1.Sheets(1)
Set wb2 = Workbooks.Open(.SelectedItems(2))
Set ws2 = wb2.Sheets(1)
End With
With ash
'tris des fichiers sur colonne E et suppression des cellules fusionnées
dl1 = ws1.Cells(Rows.Count, 4).End(xlUp).Row
dl2 = ws2.Cells(Rows.Count, 4).End(xlUp).Row
ws1.Range("D16:N" & dl1).UnMerge
ws2.Range("D16:N" & dl2).UnMerge
ws1.Range("D16:N" & dl1).Sort key1:=ws1.Range("E16"), order1:=xlAscending, Header:=xlYes
ws2.Range("D16:N" & dl2).Sort key1:=ws2.Range("E16"), order1:=xlAscending, Header:=xlYes
ws1.Rows("1:16").Copy .Range("A1")
ptr1 = 17
ptr2 = 17
li = 16
ws1.Cells(dl1 + 1, 5) = Chr$(255)
ws2.Cells(dl2 + 1, 5) = Chr$(255)
'fusion des lignes
Do
If ws1.Cells(ptr1, 5) = ws2.Cells(ptr2, 5) Then 'même id
li = li + 1
If ws1.Cells(ptr1, 11) >= ws2.Cells(ptr2, 11) Then ' score1 > score 2
ws1.Rows(ptr1).Copy .Cells(li, 1)
Else
ws2.Rows(ptr2).Copy .Cells(li, 1)
End If
If ptr1 <= dl1 Then ptr1 = ptr1 + 1
If ptr2 <= dl2 Then ptr2 = ptr2 + 1
ElseIf ws1.Cells(ptr1, 5) < ws2.Cells(ptr2, 5) Then
li = li + 1
ws1.Rows(ptr1).Copy .Cells(li, 1)
If ptr1 <= dl1 Then ptr1 = ptr1 + 1
Else
li = li + 1
ws2.Rows(ptr2).Copy .Cells(li, 1)
If ptr2 <= dl2 Then ptr2 = ptr2 + 1
End If
Loop Until ptr1 > dl1 And ptr2 > dl2
wb1.Close False
wb2.Close False
'mise en forme des résultats
.Range("D16:N" & li).Sort key1:=.Range("K16"), order1:=xlDescending, Header:=xlYes
.Range("D17") = 1
.Range("d18") = 2
.Range("D17:D18").AutoFill .Range("D17:D" & li), Type:=xlFillDefault
.Columns.AutoFit
End With
End Sub
merci à vous deux
wahou quelle efficacité. je garde la macro, super pratique
encore merci