Recherche même données dans 2 feuille différentes

Question

J'ai besoins d'une petite macro pour mon boulot ; mais je suis pas assez fort pour l'établir, alors je fais appel à l'équipe. * j'ai deux feuille que l'on nomera feuille"1" et feuille"2" * dans c'est deux feuilles, j'ai des données en colonne "B" et colonne "C" qui sont liées sur la même ligne. * j'aimerai une macro qui va analyser si je retrouve la même combinaison (feuille"2" données en colonnes "B" et "C" et sur la même ligne) dans ma feuille "1". Si je retrouve donc la même combinaison de données (colonnes "B" et "C") sur ma feuille "1" et feuille "2", j'aimerai que la macro supprime cette ligne de la feuille "2". Pouvez-vous m'aider? Bonne journée...

vba-new · Accepted Answer

Re,

Teste avec cette macro :

Sub supprDoublons()
    Dim temp(), temp2(), tablo()
    Dim i As Long, k As Long, lig As Long, limite2 As Long

    Set Dico = CreateObject("scripting.dictionary")
    Set Dico2 = CreateObject("scripting.dictionary")

    temp = Sheets(2).Range("A1").CurrentRegion.Value
    limite1 = UBound(temp, 2) + 1
    ReDim Preserve temp(1 To UBound(temp), 1 To limite1)

    For i = 1 To UBound(temp)
        temp(i, limite1) = temp(i, 2) & "$" & temp(i, 3)
    Next i
    For i = 1 To UBound(temp)
        Dico(temp(i, limite1)) = temp(i, limite1)
    Next

    temp2 = Sheets(1).Range("A1").CurrentRegion.Value
    limite2 = UBound(temp2, 2) + 1
    ReDim Preserve temp2(1 To UBound(temp2), 1 To limite2)

    For i = 1 To UBound(temp2)
        temp2(i, limite2) = temp2(i, 2) & "$" & temp2(i, 3)
    Next i
    ReDim tablo(1 To UBound(temp2), 1 To limite2 - 1)
    lig = 1
    For i = 1 To UBound(temp2)
        If Not Dico.exists(temp2(i, limite2)) Then
            For k = 1 To limite2 - 1
                tablo(lig, k) = temp2(i, k)
            Next k
            lig = lig + 1
            Dico2(temp2(i, limite2)) = temp2(i, limite2)
        End If
    Next i

    If Dico2.Count = 0 Then Sheets(1).[A2].Resize(Application.WorksheetFunction.CountA(Sheets(1).Range("A:A")) - 1, limite2 - 1).ClearContents: Exit Sub
    With Sheets(1).[A2]
        .Resize(UBound(temp2) - 1, limite2 - 1).ClearContents
        .Resize(Dico2.Count, limite2 - 1).Value = tablo
    End With

End Sub

tulipe_3 · Answer

Un essai cordialement...

vba-new · Answer

Ca peut se faire mais il faudrait que tu nous fournisses un fichier exemple avec une vingtaine de lignes avec la vraie structure des données...

vba-new · Answer

Si ton fichier n'a que 2 feuilles, un essai avec la méthode du Dictionary :

Sub supprDoublons()
Dim temp(), temp2(), tablo()
Dim i As Long, k As Long, lig As Long, limite2 As Long

Set Dico = CreateObject("scripting.dictionary")
Set Dico2 = CreateObject("scripting.dictionary")

temp = Sheets(1).Range("A1").CurrentRegion.Value
limite1 = UBound(temp, 2) + 1
ReDim Preserve temp(1 To UBound(temp), 1 To limite1)

For i = 1 To UBound(temp)
    temp(i, limite1) = temp(i, 2) & "$" & temp(i, 3)
Next i
For i = 1 To UBound(temp)
    Dico(temp(i, limite1)) = temp(i, limite1)
Next

temp2 = Sheets(2).Range("A1").CurrentRegion.Value
limite2 = UBound(temp2, 2) + 1
ReDim Preserve temp2(1 To UBound(temp2), 1 To limite2)

For i = 1 To UBound(temp2)
    temp2(i, limite2) = temp2(i, 2) & "$" & temp2(i, 3)
Next i
ReDim tablo(1 To UBound(temp2), 1 To 5)
lig = 1
For i = 1 To UBound(temp2)
    If Not Dico.exists(temp2(i, 6)) Then
        For k = 1 To 5
            tablo(lig, k) = temp2(i, k)
        Next k
        lig = lig + 1
    Dico2(temp2(i, 6)) = temp2(i, 6)
End If
Next i

With Sheets(2).[A2]
    .Resize(UBound(temp2) - 1, limite2 - 1).ClearContents
    .Resize(Dico2.Count, limite2 - 1).Value = tablo
End With

End Sub

Etant nouveau dans l'utilisation des Dictionary, le code est sûrement optimisable. Mais je pense que ça reste assez rapide (moins de 2 secondes pour des tableaux de 40000 lignes sur les 2 feuilles)

vba-new · Answer

Le fichier avec la macro incorporée. Fais gaffe c'est instantané...

gauguin · Answer

Par contre en terme de vitesse, rien à voir avec le code de vba-new qui est extrêmement rapide ! Il me faut une vingtaine de secondes pour ma part. Une autre façon de faire : Sub supprDoublon() Dim derLigneFeuille1 As Long Dim derLignePlageFeuil1 As Long Dim derLigneFeuille2 As Long Dim derLignePlageFeuil2 As Long Dim i As Integer, j As Integer Dim concatF1 As String Dim concatF2 As String derLigneFeuille1 = Sheets(1).Range("a:a").Rows.Count derLignePlageFeuil1 = Sheets("Feuille ""1""").Cells(derLigneFeuille1, 1).End(xlUp).Row derLigneFeuille2 = Sheets(2).Range("a:a").Rows.Count derLignePlageFeuil2 = Sheets("Feuille ""2""").Cells(derLigneFeuille2, 1).End(xlUp).Row For i = 2 To derLignePlageFeuil1 For j = derLignePlageFeuil2 To 2 Step -1 'If j = 3 Then Stop concatF1 = Sheets("Feuille ""1""").Cells(i, 1).Value &amp; _ Sheets("Feuille ""1""").Cells(i, 2).Value concatF2 = Sheets("Feuille ""2""").Cells(j, 1).Value &amp; _ Sheets("Feuille ""2""").Cells(j, 2).Value If concatF1 = concatF2 Then Sheets("Feuille ""2""").Cells(j, 2).EntireRow.Delete End If Next j Next i End Sub...

vba-new · Answer

Effectivement, le fait de parcourir les cellules et agir directement sur la feuille augmente considérablement le temps d'exécution. Pour pallier ce problème, j'utilise des variables tableau. Un exemple pour s'en convaincre : Sub test() 'première solution en modifiant chaque cellule t = Timer For i = 1 To 65000 For j = 1 To 4 Cells(i, j) = i Next j Next i temps1 = Timer - t 'deuxième solution avec une variable tableau t = Timer Dim tablo(1 To 65000, 1 To 4) For i = 1 To 65000 For j = 1 To 4 tablo(i, j) = i Next j Next i &#91;F1:I65000&#93; = tablo temps2 = Timer - t MsgBox temps1 &amp; " sec pour la première solution" &amp; vbCrLf &amp; _ temps2 &amp; " sec pour la deuxième solution" End Sub Chez moi, environ 10 secondes pour la première solution et environ 1 seconde pour la deuxième...

gauguin · Answer

Oui, tu as raison, j'ai souvent lu qu'il était préférable de récupérer les valeurs contenues dans les cellules, de travailler dessus puis de renvoyer tous ça dans les cellules et ton code le prouve.

Le seul "écueil" c'est que souvent les plages de cellules sur lesquelles tu veux travailler ne sont pas contigües (donc fabrication d'un range avec les colonnes contenant les cellules sur lesquelles tu veux travailler) et qu'entre deux exécutions de ton code la forme de ta feuille peut avoir changée => il faut donc nommer tes ranges en amont et prévoir des ajout de colonnes supplémentaires à intégrer et construire ton code autours de tout ça pour ne pas avoir de surprises => ça nous amène donc toujours au même constat : avoir une vision globale de l'appli bien en amont, ce qui permet d'optimiser à tous les niveaux !

Sinon j'avoue aussi que les ordis étant tellement rapides aujourd'hui et les gens tellement pressés que je fais souvent passer l'optimisation au second plan.

Merci pour ta démonstration !

vba-new · Answer

Quelle est l'erreur retournée ...

vba-new · Answer

Et que dit le message d'erreur qui s'affiche ...