Un tinder avec Excel
s
Bonjour,
J'ai réalisé un petit site internet dans mon école dans lesquels les gens vont pouvoir faire matcher deux personnes entre elles pour la saint Valentin.
Je ressors donc avec un tableau Excel à trois colonnes: Le nom du cupidon, le nom de la première personne du match et le nom de la seconde.
J'aimerai que si un match apparaît 3 fois, alors le couple est entré dans une colonne avec tous les matchs.
Avez-vous une idée de la manière dont je pourrai réaliser cela avec Excel ?
Merci par avance pour toutes les réponses :)
bonjour,
une proposition, données en colonne A à C résultat en colonne H
Sub aargh()
Dim cupidon()
m = 1 'numéro de ligne pour l'affichage du résultat
With Sheets("sheet1") ' à adapter
dl = .Cells(Rows.Count, 1).End(xlUp).Row ' dernière ligne
ReDim cupidon(dl) 'tableau des numéros de cupidon ayant indiqué le couple en cours
Set dict = CreateObject("scripting.dictionary") ' dict contient les couples déja traités
For i = 2 To dl 'on parcourt toutes les lignes
a = .Cells(i, 2) ' nom 1
b = .Cells(i, 3) 'nom 2
If a < b Then cle = a & " " & b Else cle = b & " " & a ' tri alphabétique et contitution d'une clé avec les 2 noms
If Not dict.exists(cle) Then 'couple pas encore traité
dict(cle) = 1 'on l'ajoute au dictionnaire
For j = i To dl 'on compte le nombre ligne contenant ce couple
a = .Cells(j, 2) 'nom1
b = .Cells(j, 3) 'nom2
If a < b Then clebis = a & " " & b Else clebis = b & " " & a 'tri alphabetique et constitution d'une clé avec les 2 noms
If cle = clebis Then ' occurrence du couple trouvé
ctr = ctr + 1 'on incrémente le ctr
cupidon(ctr) = j ' on note le numéro du cupidon ayant donné ce couple
End If
Next j
If ctr > 2 Then 'couple cité plus de 2 fois
m = m + 1 'on l'affiche, incrémente n° de ligne du résultat
.Cells(m, 8) = cle 'le couple
For j = 1 To ctr
.Cells(m, 8 + j) = .Cells(cupidon(j), 1) 'les cupidons ayant donné ce couple
Next j
End If
End If
ctr = 0 'remise à zero du ctr de couple
Next i
End With
End Sub