XL 2013 Copier coller si valeur correspond

Stéfane

XLDnaute Occasionnel
Bonjour à tous,


Je suis à la recherche d'une macro me permettant de comparer 2 listes, A8 et AA2, et de copier-coller, lorsque la valeur en case A correspond à la valeur en cas AA, copier les valeur de AC pour les coller en M.

Sans modification des valeurs n'étant pas dans l'une ou l'autre des 2 listes.

D'avance merci,

Stéfane
 

Pièces jointes

  • TEST1.xlsm
    10.1 KB · Affichages: 3
Solution
Par VBA

il y a un doublon en colonne AA cf Poste #1
C'est cela que vous essayer de comparer ?
213122 = 28 (Colonne AA11) ou 213122 = 34 (Colonne AA18)
Ligne 17 avec la formule = 28
Ligne 17 avec VBA = 34

VB:
Sub Comparlist()
Dim T() As Variant
ReDim T(0 To 2)
    T(0) = Range(Cells(8, 1), Cells(Cells(65536, 1).End(xlUp).Row, 1))
    T(1) = Range(Cells(2, 27), Cells(Cells(65536, 27).End(xlUp).Row, 27))
    T(2) = Range(Cells(2, 29), Cells(Cells(65536, 27).End(xlUp).Row, 29))
'
    For i = LBound(T(0), 1) To UBound(T(0), 1)
        For j = LBound(T(1), 1) To UBound(T(1), 1)
            If T(0)(i, 1) = T(1)(j, 1) Then
                Cells(i + 7, 13) = T(2)(j, 1)
            End If
        Next j
    Next i
End Sub

laurent950

XLDnaute Accro
Par VBA

il y a un doublon en colonne AA cf Poste #1
C'est cela que vous essayer de comparer ?
213122 = 28 (Colonne AA11) ou 213122 = 34 (Colonne AA18)
Ligne 17 avec la formule = 28
Ligne 17 avec VBA = 34

VB:
Sub Comparlist()
Dim T() As Variant
ReDim T(0 To 2)
    T(0) = Range(Cells(8, 1), Cells(Cells(65536, 1).End(xlUp).Row, 1))
    T(1) = Range(Cells(2, 27), Cells(Cells(65536, 27).End(xlUp).Row, 27))
    T(2) = Range(Cells(2, 29), Cells(Cells(65536, 27).End(xlUp).Row, 29))
'
    For i = LBound(T(0), 1) To UBound(T(0), 1)
        For j = LBound(T(1), 1) To UBound(T(1), 1)
            If T(0)(i, 1) = T(1)(j, 1) Then
                Cells(i + 7, 13) = T(2)(j, 1)
            End If
        Next j
    Next i
End Sub
 
Dernière édition:

Stéfane

XLDnaute Occasionnel
Bonjour

Un grand merci, votre macro fonctionne parfaitement !!
J'ai fait une erreur sur le positionnement de ma colonne AD et souhaiterais que votre formule fonctionne avec la colonne AC à la place. pas de changment sur le reste.
Comment puis-je la modifier svp ?

Merci pour votre aide.
 

laurent950

XLDnaute Accro
Pour rechercher les erreurs doublons dans la colonne AA faite un essais.

Colonne A : T(0) = Range(Cells(8, 1), Cells(Cells(65536, 1).End(xlUp).Row, 1))
Colonne AA : T(1) = Range(Cells(2, 27), Cells(Cells(65536, 27).End(xlUp).Row, 27))
Colonne AC : T(2) = Range(Cells(2, 29), Cells(Cells(65536, 27).End(xlUp).Row, 29))
Colonne M : Cells(i + 7, 13)

VB:
Sub Comparlist()
Dim Dico As Object
Set Dico = CreateObject("Scripting.Dictionary")
Dim Doublon As String

Dim T() As Variant
ReDim T(0 To 2)
    T(0) = Range(Cells(8, 1), Cells(Cells(65536, 1).End(xlUp).Row, 1))
    T(1) = Range(Cells(2, 27), Cells(Cells(65536, 27).End(xlUp).Row, 27))
    T(2) = Range(Cells(2, 29), Cells(Cells(65536, 27).End(xlUp).Row, 29))
 
    For j = LBound(T(1), 1) To UBound(T(1), 1)
        If Dico.Exists(T(1)(j, 1)) Then
            Doublon = Dico.Item(T(1)(j, 1))
            Dico.Remove (T(1)(j, 1))
            Dico.Add T(1)(j, 1), T(2)(j, 1) & "/" & Doublon
        Else
            Dico.Add T(1)(j, 1), T(2)(j, 1)
        End If
    Next j
'
    For i = LBound(T(0), 1) To UBound(T(0), 1)
        For j = LBound(T(1), 1) To UBound(T(1), 1)
            If T(0)(i, 1) = T(1)(j, 1) Then
                Doublon = Dico.Item(T(1)(j, 1))
                    Cells(i + 7, 13) = Doublon
            End If
        Next j
    Next i
End Sub
 
Dernière édition:

Stéfane

XLDnaute Occasionnel
Merci à vous, votre 1ère formule fonctionnait déjà parfaitement.
Je souhaite juste la modifier pour qu'au lieu de faire la comparaison de la colonne A avec la colonne AD, celle-ci ce fasse entre la colonne A et la colonne AC.

Merci pour votre aide
 

Discussions similaires

Statistiques des forums

Discussions
312 207
Messages
2 086 230
Membres
103 160
dernier inscrit
Torto