Twitter iPhone pliant OnePlus 11 PS5 Disney+ Orange Livebox Windows 11

Comparer deux colonnes dans deux classeurs differents

2 réponses
Avatar
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

Tamaliko

2 réponses

Avatar
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?
Avatar
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
'-----------------------------------------------------------------