comparer plusieurs lignes à plusieurs lignes et afficher des resultats

[aymeric789852]

Bonjour,

J'ai 2 tableaux, l'un sur une feuille et l'autre sur une autre, le tout dans le même classeur. J'aimerai que c'est 2 tableaux soit comparés ligne par ligne et qu'il soit affiché le ou les résultats au bout des lignes.

Voici mon fichier pour mieux comprendre:

Ce lien n'existe plus

Chaque ligne du tableau de la feuille 'donnée 2' doit être comparé avec toutes les lignes du tableau de la feuille 'donnée 1'. Si 3 critères ou plus du tableau de donnée 2 (critère 1 à critère 7) sont supérieur aux critères du tableau de donnée 1, alors il faudrait afficher le matricule du tableau de donnée 1 sur la même ligne avec laquelle a été faite la comparaison et la même feuille que le tableau de donnée 2. Si il existe plusieurs résultats alors il faudrait les afficher toujours sur la même ligne mais dans les colonne suivante.

Exemple:

Dans le tableau de 'Donnée 2':
la ligne du matricule "EEE" doit être comparée avec toutes celles du tableau de Donnée 1.
Lorsque l'on compare manuellement:
--le matricule "AAAA" à 2 critères qui sont supérieurs à "EEE" (critères 5 et 7);
--le matricule "BBBB" à 3 critères qui sont supérieurs à "EEE" (critères 2,3 et 7);
--le matricule "CCCC" à 2 critères qui sont supérieurs à "EEE" (critères 5 et 7);
--le matricule "DDDD" à 4 critères qui sont supérieurs à "EEE" (critères 1,3,6 et 7)
Je voudrait que les matricules "BBBB" et "DDDD" soient affichés sur la ligne de "EEE" (soit la ligne 12 de 'donnée 2'); qu'ils s'affichent dans l'ordre décroissant (du plus grand nombre de critères supérieurs au plus petit, et ce, dans des colonnes consécutives. Ici dans l'exemple, DDDD serait affiché dans la cellule "K12" de 'donnée 2' et "BBBB" dans la cellule "L12" de 'donnée 2'.

Les 2 tableaux ne sont pas limités en nombre lignes. Il est possible d'avoir 50 ligne comme 1000


Merci de votre aide car je suis un peu perdu dans tout sa et je ne sais pas quoi utiliser (formule ? macro ? si macro je n'en ai jamais fait...)

 

[CHALET53]

Re : comparer plusieurs lignes à plusieurs lignes et afficher des resultats

Bonjour,

Un essai par macro

Cliquer sur le bouton Lance

en passant par la feuille 3

a+

 

[fhoest]

Re : comparer plusieurs lignes à plusieurs lignes et afficher des resultats

Bonjour,
Edit Bonjour Chalet53.
voilà pour toi un début de code à modifier car il n'est pas au top de ce que tu demandes.

Sub Bouton1_Cliquer()
'instancier les variables.
Dim i As Long, j As Long, x As Long, w As Long, z As Long
Dim mon_Tabd1(6) As Variant
Dim mon_tabd2(6) As Variant
Dim mon_dico As Variant
Dim compte As Integer
Dim removall
Dim dernière_ligne_F1 As Long
Dim dernière_ligne_F2 As Long
'creation du dico
Set mon_dico = CreateObject("scripting.dictionary")

dernière_ligne_F1 = Sheets("donnée 1").Range("A12").End(xlDown).Row + 1
dernière_ligne_F2 = Sheets("donnée 2").Range("A12").End(xlDown).Row + 1

'boucle sur la feuille donné 2 et attribution des valeurs dans le tableau de données mon_tabd2
For i = 12 To dernière_ligne_F2
'effacement des valeur du dico
removall = mon_dico.RemoveAll

With Sheets("donnée 2")
mon_tabd2(0) = .Range("D" & i).Text
mon_tabd2(1) = .Range("E" & i).Text
mon_tabd2(2) = .Range("F" & i).Text
mon_tabd2(3) = .Range("G" & i).Text
mon_tabd2(4) = .Range("H" & i).Text
mon_tabd2(5) = .Range("I" & i).Text
mon_tabd2(6) = .Range("J" & i).Text
End With

'boucle sur la feuille donné 1 et attribution des valeurs dans le tableau de données mon_tabd1
For j = 12 To dernière_ligne_F1

With Sheets("donnée 1")
compte = 0
mon_Tabd1(0) = .Range("D" & j).Text
mon_Tabd1(1) = .Range("E" & j).Text
mon_Tabd1(2) = .Range("F" & j).Text
mon_Tabd1(3) = .Range("G" & j).Text
mon_Tabd1(4) = .Range("H" & j).Text
mon_Tabd1(5) = .Range("I" & j).Text
mon_Tabd1(6) = .Range("J" & j).Text
End With
'boucle et ajout des valeurs au dico
For x = 0 To 6
If mon_Tabd1(x) < mon_tabd2(x) Then compte = compte + 1
Next
mon_dico.Add mon_dico.Count, compte
Next

'tri de mon_dico du plus petit au plus grand
For z = 0 To mon_dico.Count
    For w = 0 To mon_dico.Count

    If mon_dico(w) > mon_dico(w + 1) Then

      Temp = mon_dico(w): mon_dico(w) = mon_dico(w + 1): mon_dico(w + 1) = Temp
    End If

    Next w

Next z
'écriture des valeurs sur la feuille de donnée 2
For y = 0 To mon_dico.Count
Dim col As Long
col = Sheets("donnée 2").Range("D" & i).End(xlToRight).Column + 1
If mon_dico(y) > 2 Then Sheets("donnée 2").Cells(i, col).Value = mon_dico(y)
Next
Next
End Sub

A+

 

[néné06]

Re : comparer plusieurs lignes à plusieurs lignes et afficher des resultats

Bonjour à tous,

Ma petite version , si j'ai bien saisis la demande ?

Public Sub Rechercher()
    ligne_debut_donnée_2 = 11 'Repére ligne de titres en "donnée 2"
    ligne_debut_donnée_1 = 11 'Repére ligne de titres en "donnée 1"
    der_li_D2 = Sheets("donnée 2").Cells.Find("*", , , , , xlPrevious).Row 'Trouve la derniere ligne écrite donnée 2
    der_li_D1 = Sheets("donnée 1").Cells.Find("*", , , , , xlPrevious).Row 'Trouve la derniere ligne écrite donnée 1
        For i = ligne_debut_donnée_2 + 1 To der_li_D2 ' prendre lignes D2 deb/fin
        v = 11
            For m = ligne_debut_donnée_1 + 1 To der_li_D1 ' prendre lignes D1 deb/fin
                critere = 0
                For j = 4 To 10
                    If Sheets("donnée 2").Cells(i, j) > Sheets("donnée 1").Cells(m, j) Then
                        critere = critere + 1
                    End If
                Next j
                If critere > 2 Then
                Sheets("donnée 2").Cells(i, v) = Sheets("donnée 1").Cells(m, 1)
                v = v + 1
                End If
            Next m
        Next i
end sub

A+

Rene