Titre du sujet : Re: recherche de doublons
par myDearFriend! le 20/09/2007 21:32:44
Bonjour jc, le Forum,
Je te propose la solution suivante qui devrait, je pense, respecter l'ensemble des contraintes exposées plus haut :
Option Explicit
Sub mDFtraitement()
'myDearFriend! - www.mdf-xlpages.com
Dim DB As New Collection
Dim Cel As Range
Dim Cle As String, Chaine As String
Dim LigneDuo As Integer
Dim Partie As Byte, NJ As Byte, Jeu As Byte, Duo As Byte
'Nombre de jeux par partie
NJ = Application.Max(Range("A1:IV6").Value) \ 4
On Error GoTo Doublon
For Partie = 1 To 5
For Jeu = 1 To NJ
For Duo = 1 To 4
Set Cel = Cells(2 + Choose(Duo, 0, 2, 4, 4) + (Partie - 1) * 6, Jeu + 1)
If Val(Cel.Value) <> 0 Then
LigneDuo = Choose(Duo, 1, 1, -2, -1)
Cle = Format(Application.Min(Cel.Value, Cel.Offset(LigneDuo, 0).Value), "00") & Format(Application.Max(Cel.Value, Cel.Offset(LigneDuo, 0).Value), "00")
DB.Add CStr(Partie) & CStr(Jeu), Cle
End If
Next Duo
Next Jeu
Next Partie
On Error GoTo 0
Exit Sub
Doublon:
If Err.Number = 457 Then
Chaine = "Le 'Duo' " & Left(Cle, 2) & " - " & Right(Cle, 2) & " est en doublon :" & _
vbLf & "Partie " & Left(DB(Cle), 1) & " - Jeu " & Mid(DB(Cle), 2) & _
vbLf & "Partie " & CStr(Partie) & " - Jeu " & CStr(Jeu)
MsgBox Chaine
Err.Clear
End If
Resume Next
End Sub
Tu trouveras ci-joint le classeur mettant en oeuvre cette procédure.
J'espère avoir pu t'aider...
Cordialement,
|
Didier FOURGEOT