Comparer deux colonnes dans deux classeurs differents
2 réponses
tamaliko
Bonjour,
Je suis en fait nouveau sur le Forum et après l' avoir parcouru. je n'ai pas pu trouver la réponse à mon problème qui est le suivant:
Je possédé deux classeurs dans lesquelles je voudrais comparer deux colonnes de deux feuilles différentes(chacune dans un classeur) et en cas d' égalité, copie et coller les cellules d' une colonne de la deuxième feuille dans une colonne de la feuille du premier classeur. pour être plus explicite.
Dans le classeurs1 on' a la feuille" Appareil" avec la colonne" N° de série" qui contient 13292 lignes.
dans le classeur2 on' a la feuille "Tableau" avec les colonnes" N° de série" et "N° de matériel". La tache consiste à comparer les numéros de série dans les deux classeurs et lorsqu' ils sont identique , écrire le N° de matériel correspondant dans une colonne "Matériel" de la feuille" Appareil" dans le" classeur1".
De cette manière je pourrai reconstitue ma base de donnée de telle manière que qu' un numéro de matériel et de série soient associes à un appareil
Je pense avoir été précis et dans le cas contraire n’hésitez de me le dire. Merci d' avance pour votre aide et contribution
Cette action est irreversible, confirmez la suppression du commentaire ?
Signaler le commentaire
Veuillez sélectionner un problème
Nudité
Violence
Harcèlement
Fraude
Vente illégale
Discours haineux
Terrorisme
Autre
MichD
Bonjour,
Dans chacune des listes des deux fichiers, est-ce qu'il peut y avoir des doublons ou plus?
Comment décris-tu "égalité" entre les 2 colonnes? Pourvu que la donnée de la colonne A se retrouve dans la colonne du fichier B, pas nécessairement sur la même ligne, mais seulement dans la liste?
Seuls les numéros identiques t'intéressent?
Bonjour,
Dans chacune des listes des deux fichiers, est-ce qu'il peut y avoir des
doublons ou plus?
Comment décris-tu "égalité" entre les 2 colonnes? Pourvu que la donnée de la
colonne A se retrouve dans la colonne du fichier B, pas nécessairement sur
la même ligne, mais seulement dans la liste?
Dans chacune des listes des deux fichiers, est-ce qu'il peut y avoir des doublons ou plus?
Comment décris-tu "égalité" entre les 2 colonnes? Pourvu que la donnée de la colonne A se retrouve dans la colonne du fichier B, pas nécessairement sur la même ligne, mais seulement dans la liste?
Seuls les numéros identiques t'intéressent?
MichD
Bonjour,
A ) Les deux classeurs dont il est question doivent être ouverts
B ) Tu colles la procédure dans un module standard d'un des 2 fichiers.
C ) À trois endroits dans le code, tu dois adapter le vrai nom des fichiers incluant leur extension
Voici la procédure : Sauf pour le nom des classeurs, la procédure utilise les noms des objets que tu as définis dans ta présentation.
'----------------------------------------------------------------- Sub test()
Dim Rg As Range, Rg1 As Range, C As Range Dim Trouve As Range, DerLig As Long, A As Long Dim Dic As Object
Set Dic = CreateObject("Scripting.Dictionary")
'Modifier le nom du classeur With Workbooks("Classeur1.xlsx") With .Worksheets("Appareil") With .Cells Set Trouve = .Find(What:="N° de série", LookIn:=xlValues, _ lookat:=xlWhole, searchorder:=xlByRows, _ searchdirection:=xlNext, MatchCase:úlse) End With If Not Trouve Is Nothing Then DerLig = .Cells(65536, Trouve.Column).End(xlUp).Row Set Rg = .Range(Trouve.Address, .Cells(DerLig, Trouve.Column)) Else MsgBox "La colonne ""N° de série"" n'a pas été trouvée. " & _ "Fin de l'opération." Exit Sub End If End With End With
'Modifier le nom du classeur With Workbooks("Classeur2.xlsx") With .Worksheets("Tableau") With .Cells Set Trouve = .Find(What:="N° de matériel", LookIn:=xlValues, _ lookat:=xlWhole, searchorder:=xlByRows, _ searchdirection:=xlNext, MatchCase:úlse) End With If Not Trouve Is Nothing Then DerLig = .Cells(65536, Trouve.Column).End(xlUp).Row Set Rg1 = .Range(Trouve.Address, .Cells(DerLig, Trouve.Column)) Else MsgBox "La colonne ""N° de matériel"" n'a pas été trouvée. " & _ "Fin de l'opération." Exit Sub End If End With End With
For Each C In Rg X = Application.Match(C, Rg1, 0) If IsNumeric(X) Then If Not Dic.Exists(C.Value) Then Dic.Add C.Value, C.Address End If Else Err.Clear End If Next
For Each C In Rg1 X = Application.Match(C, Rg, 0) If IsNumeric(X) Then If Not Dic.Exists(C.Value) Then Dic.Add C.Value, C.Address End If Else Err.Clear End If Next
'Modifier le nom du classeur With Workbooks("Classeur1.xlsx") With .Worksheets("Appareil") With .Cells Set Trouve = .Find(What:="Matériel", LookIn:=xlValues, _ lookat:=xlWhole, searchorder:=xlByRows, _ searchdirection:=xlNext, MatchCase:úlse) End With End With If Not Trouve Is Nothing Then Trouve.Offset(1).Resize(Dic.Count) = Application.Transpose(Dic.Keys) Else .Worksheets.Add .ActiveSheet.Range("A1").Resize(UBound(T)) = Application.Transpose(Dic.Keys) End If End With End Sub '-----------------------------------------------------------------
Bonjour,
A ) Les deux classeurs dont il est question doivent être ouverts
B ) Tu colles la procédure dans un module standard d'un des 2 fichiers.
C ) À trois endroits dans le code, tu dois adapter le vrai nom des fichiers
incluant leur extension
Voici la procédure : Sauf pour le nom des classeurs, la procédure utilise
les noms des objets
que tu as définis dans ta présentation.
'-----------------------------------------------------------------
Sub test()
Dim Rg As Range, Rg1 As Range, C As Range
Dim Trouve As Range, DerLig As Long, A As Long
Dim Dic As Object
Set Dic = CreateObject("Scripting.Dictionary")
'Modifier le nom du classeur
With Workbooks("Classeur1.xlsx")
With .Worksheets("Appareil")
With .Cells
Set Trouve = .Find(What:="N° de série", LookIn:=xlValues, _
lookat:=xlWhole, searchorder:=xlByRows, _
searchdirection:=xlNext, MatchCase:úlse)
End With
If Not Trouve Is Nothing Then
DerLig = .Cells(65536, Trouve.Column).End(xlUp).Row
Set Rg = .Range(Trouve.Address, .Cells(DerLig, Trouve.Column))
Else
MsgBox "La colonne ""N° de série"" n'a pas été trouvée. " & _
"Fin de l'opération."
Exit Sub
End If
End With
End With
'Modifier le nom du classeur
With Workbooks("Classeur2.xlsx")
With .Worksheets("Tableau")
With .Cells
Set Trouve = .Find(What:="N° de matériel", LookIn:=xlValues, _
lookat:=xlWhole, searchorder:=xlByRows, _
searchdirection:=xlNext, MatchCase:úlse)
End With
If Not Trouve Is Nothing Then
DerLig = .Cells(65536, Trouve.Column).End(xlUp).Row
Set Rg1 = .Range(Trouve.Address, .Cells(DerLig, Trouve.Column))
Else
MsgBox "La colonne ""N° de matériel"" n'a pas été trouvée. " & _
"Fin de l'opération."
Exit Sub
End If
End With
End With
For Each C In Rg
X = Application.Match(C, Rg1, 0)
If IsNumeric(X) Then
If Not Dic.Exists(C.Value) Then
Dic.Add C.Value, C.Address
End If
Else
Err.Clear
End If
Next
For Each C In Rg1
X = Application.Match(C, Rg, 0)
If IsNumeric(X) Then
If Not Dic.Exists(C.Value) Then
Dic.Add C.Value, C.Address
End If
Else
Err.Clear
End If
Next
'Modifier le nom du classeur
With Workbooks("Classeur1.xlsx")
With .Worksheets("Appareil")
With .Cells
Set Trouve = .Find(What:="Matériel", LookIn:=xlValues, _
lookat:=xlWhole, searchorder:=xlByRows, _
searchdirection:=xlNext, MatchCase:úlse)
End With
End With
If Not Trouve Is Nothing Then
Trouve.Offset(1).Resize(Dic.Count) = Application.Transpose(Dic.Keys)
Else
.Worksheets.Add
.ActiveSheet.Range("A1").Resize(UBound(T)) =
Application.Transpose(Dic.Keys)
End If
End With
End Sub
'-----------------------------------------------------------------
A ) Les deux classeurs dont il est question doivent être ouverts
B ) Tu colles la procédure dans un module standard d'un des 2 fichiers.
C ) À trois endroits dans le code, tu dois adapter le vrai nom des fichiers incluant leur extension
Voici la procédure : Sauf pour le nom des classeurs, la procédure utilise les noms des objets que tu as définis dans ta présentation.
'----------------------------------------------------------------- Sub test()
Dim Rg As Range, Rg1 As Range, C As Range Dim Trouve As Range, DerLig As Long, A As Long Dim Dic As Object
Set Dic = CreateObject("Scripting.Dictionary")
'Modifier le nom du classeur With Workbooks("Classeur1.xlsx") With .Worksheets("Appareil") With .Cells Set Trouve = .Find(What:="N° de série", LookIn:=xlValues, _ lookat:=xlWhole, searchorder:=xlByRows, _ searchdirection:=xlNext, MatchCase:úlse) End With If Not Trouve Is Nothing Then DerLig = .Cells(65536, Trouve.Column).End(xlUp).Row Set Rg = .Range(Trouve.Address, .Cells(DerLig, Trouve.Column)) Else MsgBox "La colonne ""N° de série"" n'a pas été trouvée. " & _ "Fin de l'opération." Exit Sub End If End With End With
'Modifier le nom du classeur With Workbooks("Classeur2.xlsx") With .Worksheets("Tableau") With .Cells Set Trouve = .Find(What:="N° de matériel", LookIn:=xlValues, _ lookat:=xlWhole, searchorder:=xlByRows, _ searchdirection:=xlNext, MatchCase:úlse) End With If Not Trouve Is Nothing Then DerLig = .Cells(65536, Trouve.Column).End(xlUp).Row Set Rg1 = .Range(Trouve.Address, .Cells(DerLig, Trouve.Column)) Else MsgBox "La colonne ""N° de matériel"" n'a pas été trouvée. " & _ "Fin de l'opération." Exit Sub End If End With End With
For Each C In Rg X = Application.Match(C, Rg1, 0) If IsNumeric(X) Then If Not Dic.Exists(C.Value) Then Dic.Add C.Value, C.Address End If Else Err.Clear End If Next
For Each C In Rg1 X = Application.Match(C, Rg, 0) If IsNumeric(X) Then If Not Dic.Exists(C.Value) Then Dic.Add C.Value, C.Address End If Else Err.Clear End If Next
'Modifier le nom du classeur With Workbooks("Classeur1.xlsx") With .Worksheets("Appareil") With .Cells Set Trouve = .Find(What:="Matériel", LookIn:=xlValues, _ lookat:=xlWhole, searchorder:=xlByRows, _ searchdirection:=xlNext, MatchCase:úlse) End With End With If Not Trouve Is Nothing Then Trouve.Offset(1).Resize(Dic.Count) = Application.Transpose(Dic.Keys) Else .Worksheets.Add .ActiveSheet.Range("A1").Resize(UBound(T)) = Application.Transpose(Dic.Keys) End If End With End Sub '-----------------------------------------------------------------