XL 2016 [VBA] Copier données d'une feuille vers une autre feuille en fonction d'une valeur "critère"

[Jauster]

Bonjour le forum,

Ci-joint un fichier exemple avec 200 lignes pour vous aider à visualiser mon problème :
ExempleExcelDownloads.xlsx

Suite à plusieurs macro j'obtiens deux feuilles "Mono" et "Mono2". "Mono" correspond aux produits disponibles en J. "Mono2" correspond à ceux de J-1.
Certaines données de Mono2 doivent être copiées sur Mono (Colonnes en Jaune > Value1 à Value6).
L'EAN est un code unique attribué à un produit, il peut donc être utilisé pour différencier tous les produits. Le problème est que l'ordre des produits peut être changé, ou certains produits peuvent être ajoutés/retirés entre Mono et Mono2 donc je ne peux pas juste copier/paste les valeurs d'une feuille à l'autre

Je pensais notamment utiliser Application.WorksheetFunction.VLookup mais c'est plutot long et pas super propre, surtout avec plus de 10.000 lignes.

Existe-t-il un autre moyen de le faire ?

EDIT : La colonne I de la feuille Mono2 ne devrait pas être en Jaune mais je n'arrive pas à upload le fichier corrigé
Merci

 

[vgendron]

Hello
un essai avec ce code

Sub Mono()

Set MonDico = CreateObject("scripting.dictionary")
Dim Tablo2() As Variant
Dim Tablo() As Variant

With Sheets("Mono2")
    fin = .Range("D" & .Rows.Count).End(xlUp).Row
    Tablo2 = .Range("D3:N" & fin).Value
End With
For i = LBound(Tablo2, 1) To UBound(Tablo2, 1)
    valeur = ""
    For j = 5 To 11
        valeur = valeur & "-" & Tablo2(i, j)
    Next j
    MonDico.Add Tablo2(i, 1), valeur
Next i

With Sheets("Mono")
    FinMono = .Range("D" & .Rows.Count).End(xlUp).Row
    Tablo = .Range("D3:N" & fin).Value
    On Error Resume Next
    For i = LBound(Tablo, 1) To UBound(Tablo, 1)
        For j = 5 To 11
            Tablo(i, j) = Split(MonDico(Tablo(i, 1)), "-")(j - 4)
        Next j
    Next i
    .Range("D3:N" & FinMono) = Tablo
End With

End Sub

 

[Jauster]

Hello Vgendron,

Super cool, c'est exactement ca, et en plus tellement rapide... Je vais devoir regarder assez vite le fonctionnement des Tablo que je ne maitrise pas encore.
Je me permets juste de remonter une erreur (surement d'inattention) : Dans la deuxième partie du code pour Mono tu utilises encore une fois la variable "fin" ce qui remplace mes lignes 199 et 200 par des NA. J'ai remplacé par FinMono.

    Tablo = .Range("D3:N" & fin).Value

Encore merci

 

[vgendron]

avec ce code ci plutot.. il y avait une erreur d'indice

Sub Mono()

Set MonDico = CreateObject("scripting.dictionary")
Dim Tablo2() As Variant
Dim Tablo() As Variant

With Sheets("Mono2")
    fin = .Range("D" & .Rows.Count).End(xlUp).Row
    Tablo2 = .Range("D3:N" & fin).Value
End With
For i = LBound(Tablo2, 1) To UBound(Tablo2, 1)
    valeur = ""
    For j = 5 To 11
        valeur = valeur & "-" & Tablo2(i, j)
    Next j
    MonDico.Add Tablo2(i, 1), valeur
Next i

With Sheets("Mono")
    FinMono = .Range("D" & .Rows.Count).End(xlUp).Row
    Tablo = .Range("D3:N" & FinMono).Value
    On Error Resume Next
    For i = LBound(Tablo, 1) To UBound(Tablo, 1)
        For j = 5 To 11
            Tablo(i, j) = Split(MonDico(Tablo(i, 1)), "-")(j - 4)
        Next j
    Next i
    .Range("D3:N" & FinMono) = Tablo
End With

End Sub

 

[Jauster]

Re,

Après plusieurs jours de test, la macro fonctionne plutôt bien. Mais à certains moment j'ai une erreur 457 : "This key is already associated with an element of this collection". L'erreur pointe sur la ligne MonDico.Add Tablo2(i, 1), valeur lorsque i=2.
J'ai modifié le code ci-joint et je ne sais pas d'où vient l'erreur.

Sub ModifManu()
Dim fin As Integer, FinMono As Integer

Set MonDico = CreateObject("scripting.dictionary")
Dim Tablo2() As Variant
Dim Tablo() As Variant

With wsMONO2
    fin = .Range("D" & .Rows.Count).End(xlUp).Row
    Tablo2 = .Range("D3:N" & fin).Value
End With
For i = LBound(Tablo2, 1) To UBound(Tablo2, 1)
    valeur = ""
    For j = 6 To 11
        valeur = valeur & "-" & Tablo2(i, j)
    Next j
    MonDico.Add Tablo2(i, 1), valeur
Next i

With wsMono
    FinMono = .Range("D" & .Rows.Count).End(xlUp).Row
    Tablo = .Range("D3:N" & FinMono).Value
    On Error Resume Next
    For i = LBound(Tablo, 1) To UBound(Tablo, 1)
        For j = 6 To 11
            Tablo(i, j) = Split(MonDico(Tablo(i, 1)), "-")(j - 5)
        Next j
    Next i
    .Range("D3:N" & FinMono) = Tablo
End With

End Sub

 

[vgendron]

Bonjour Jauster

Je viens de lancer ta macro modifiée dans le fichier du post 1.. et je ne vois pas d'erreur...??

 

[Jauster]

Bonjour Jauster

Je viens de lancer ta macro modifiée dans le fichier du post 1.. et je ne vois pas d'erreur...??

Justement, l'erreur n’apparaît pas tout le temps et je ne sais pas ce qui la cause donc impossible de la reproduire...

 

[Jauster]

Je pensais que c'était une erreur possible avec l'utilisation de tablo comme je ne l'ai jamais rencontré. Je vais faire plusieurs test et voir si j'arrive à provoquer l'erreur

 

[vgendron]

l'erreur est certainement due au fait que dans le fichier que tu utilises, un EAN apparait deux fois..
essaie avec ce code qui gère l'erreur

Sub Mono()

Set MonDico = CreateObject("scripting.dictionary")
Dim Tablo2() As Variant
Dim Tablo() As Variant

With Sheets("Mono2")
    fin = .Range("D" & .Rows.Count).End(xlUp).Row
    Tablo2 = .Range("D3:N" & fin).Value
End With
For i = LBound(Tablo2, 1) To UBound(Tablo2, 1)
    valeur = ""
    For j = 5 To 11
        valeur = valeur & "-" & Tablo2(i, j)
    Next j
    On Error GoTo Err
    MonDico.Add Tablo2(i, 1), valeur
Next i

With Sheets("Mono")
    FinMono = .Range("D" & .Rows.Count).End(xlUp).Row
    Tablo = .Range("D3:N" & FinMono).Value
    On Error Resume Next
    For i = LBound(Tablo, 1) To UBound(Tablo, 1)
        For j = 5 To 11
            Tablo(i, j) = Split(MonDico(Tablo(i, 1)), "-")(j - 4)
        Next j
    Next i
    .Range("D3:N" & FinMono) = Tablo
End With

Err:
If Err.Number = 457 Then
    MsgBox ("le code EAN: " & i & " apparait deux fois")
End If

End Sub

 

[Jauster]

Hello,

Je ne pense pas puisque quelques macros avant de lancer celle-ci je retire les doubles de la colonne EAN :

Sub RemoveDoubleMono()
Dim MyRange As Range

With wsMono
    .Activate
    .Columns("D:D").NumberFormat = "0"
    DerLig = .Range("D" & Rows.Count).End(xlUp).Row
Set MyRange = .Range("A1:T" & DerLig)
    MyRange.RemoveDuplicates Columns:=4, Header:=xlYes
End With
End Sub

------

Je vais tout de même ajouter le gestionnaire d'erreur, mais dans ce cas comment le tablo va-t-il gerer le doublon ? Ne rien copier ? Ou juste ignorer le fait que c'est un double ? Passer au For suivant ?