Un tinder avec Excel

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 ?

capture d e cran 2022 02 01 a 09 45 31

Merci par avance pour toutes les réponses :)

S'il vous plait personne?

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
Rechercher des sujets similaires à "tinder"