1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63
|
Sub comparer_score()
Dim Ancien_classement As Worksheet
Dim Classement_actuel As Worksheet
Dim Resultat As Worksheet
Dim Plage_Ancien As Range
Dim Plage_Actuel As Range
Dim Cel_Find As Range
Dim Cel As Range
Dim Ligne As Long
'pour le test
' Set Ancien_classement = Worksheets("Feuil1")
' Set Classement_actuel = Worksheets("Feuil2")
' Set Resultat = Worksheets("Feuil3")
'défini les plages de recherche
With Ancien_classement
Set Plage_Ancien = .Range(.[A1], .[A65536].End(xlUp))
End With
With Classement_actuel
Set Plage_Actuel = .Range(.[A1], .[A65536].End(xlUp))
End With
'recherche la dernière ligne non vide
With Resultat
Ligne = .Range("A" & .Rows.Count).End(xlUp).Row
If Ligne > 1 Then Ligne = Ligne + 1
End With
'effectue la recherche pour chaque nom
For Each Cel In Plage_Ancien
Set Cel_Find = Plage_Actuel.Find(Cel, , xlValues, xlWhole)
'et si trouvé, envoi des résultats dans la feuille Resultat
If Not Cel_Find Is Nothing Then
With Resultat
.Range("A" & Ligne) = Cel 'nom du joueur
.Range("B" & Ligne) = Cel.Offset(0, 1) 'Ancien score
.Range("C" & Ligne) = Cel_Find.Offset(0, 2) 'colonne C
.Range("D" & Ligne) = Cel_Find.Offset(0, 3) 'colonne D
.Range("E" & Ligne) = Cel_Find.Offset(0, 1) 'colonne B
Ligne = Ligne + 1
End With
End If
Next Cel
End Sub |
Partager