Logo GNT
Actualités Tests & Guides Bons Plans
Twitter iPhone pliant OnePlus 11 PS5 Disney+ Orange Livebox Windows 11
Entraide Applications Microsoft Office Excel comparer 2 feuilles excel dans Excel 2007

comparer 2 feuilles excel dans Excel 2007

5 réponses
Avatar
vdenis3399
Bonjour,

J ai 2 bases de données que j ai concatainé (si cela se dit) pour pouvoir
comparer chaque ligne de la feuille 1 avec celles de la feuille 2, mais je n
ai pas le même nombre de lignes dans les 2 feuilles excel.

J aimerais afficher dans une 3e feuille le résultat suivant : toutes les
lignes qui ne sont pas identiques dans la feuille 1 & 2.

La macro ci-dessous me permet d avoir dans la 3e feuille les lignes
identiques de la feuille 1 & 2 mais moi j aimerais avoir les lignes qui ne
sont pas identiques à la fois dans la feuille 1 & 2.

Sub test()
Dim FL1 As Worksheet 'Feuille 1
Dim FL2 As Worksheet 'Feuille 2
Dim FL3 As Worksheet 'Feuille 2
Dim c As Range, DerLig3 As Long
Dim Tablo As Variant, Derlig As Long, NoLig As Long
Application.ScreenUpdating = False
'Instanciation des feuilles de calculs concernées (pour simplifier le code à
venir)
Set FL1 = Worksheets("Feuil1")
Set FL2 = Worksheets("Feuil2")
Set FL3 = Worksheets("Feuil3")
'Recherche de la dernière ligne de la plage de données feuil1
Derlig = Split(FL1.UsedRange.Address, "$")(4)
'Création du tableau
Tablo = FL1.Range("A2:C" & Derlig).Value
'Parcours du tableau (pris feuil1) et recherche de la donnée feuil2
With FL2.Range("A2:A" & Split(FL2.UsedRange.Address, "$")(4))
For NoLig = 1 To UBound(Tablo) 'ou bien to DerLig (revient au même)
Set c = .Find(Tablo(NoLig, 1))
If Not c Is Nothing Then
'la donnée a été trouvée, on la copie dans feuil3 après la dernière ligne
DerLig3 = FL3.Range("A" & Rows.Count).End(xlUp).Row
FL2.Rows(c.Row).Copy FL3.Range("A" & DerLig3 + 1)
End If
Next
End With
End Sub


Merci
Signaler un problème avec ce contenu

5 réponses

Supprimer
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
Avatar
Starwing
Option Explicit
Const Vcol As Long = 5 'Vérifie 5 premieres colonnes

Sub Itemsdifferents()
Application.ScreenUpdating = False
Dim RngA As Range, RngB As Range, Cll As Range
Dim K&, Ka&, Kb&, Kf&, Rw&, Cola&, Colb&, Limita&
Dim Tablo(), Tabuniq As Variant, Vardatas As Variant
Ka = Feuil1.Cells(65536, 1).End(xlUp).Row
Kb = Feuil2.Cells(65536, 1).End(xlUp).Row
Cola = 1: Colb = 1
Feuil3.Cells.ClearContents
Set RngA = Feuil1.Range("A2").Resize(Ka, 1)
Set RngB = Feuil2.Range("A2").Resize(Kb, 1)
ReDim Tablo(1 To Ka + Kb, 1)
Rw = 1
For Each Cll In RngB
If Application.CountIf(RngA, Cll.Value) = 0 Then
Tablo(Rw, 1) = Cll.Value
Rw = Rw + 1
End If
Next
Limita = Rw - 1
Rw = Rw - 1

For Each Cll In RngA
If Application.CountIf(RngB, Cll.Value) = 0 Then
Tablo(Rw, 1) = Cll.Value
Rw = Rw + 1
End If
Next

Feuil3.Cells(1, 1) = Feuil1.Cells(1, 1)
For Rw = LBound(Tablo) To Limita
Feuil3.Cells(Rw + 1, Cola) = Tablo(Rw, 1)
Next

Tabuniq = Feuil3.Cells(1, Cola).Resize(Limita, Cola).Value
Vardatas = Feuil2.Cells(1, Colb).Resize(Kb, Vcol).Value

For K = LBound(Vardatas) To UBound(Vardatas)
For Kf = LBound(Tabuniq, 1) To UBound(Tabuniq, 1)
If Vardatas(K, 1) = Tabuniq(Kf, 1) Then
Feuil3.Cells(Kf, 2) = Vardatas(K, 2)
Feuil3.Cells(Kf, 3) = Vardatas(K, 3)
Feuil3.Cells(Kf, 4) = Vardatas(K, 4)
Feuil3.Cells(Kf, Vcol) = Vardatas(K, Vcol)
End If
Next Kf
Next K
Erase Vardatas
Erase Tabuniq

For Rw = Limita + 1 To UBound(Tablo)

Feuil3.Cells(Rw + 1, Cola) = Tablo(Rw, 1)
Next

Vardatas = Feuil1.Cells(1, Cola).Resize(Ka, Vcol).Value
Tabuniq = Feuil3.Cells(Limita + 1, Cola).Resize(Rw, Cola).Value

For K = LBound(Vardatas) To UBound(Vardatas)
For Kf = LBound(Tabuniq, 1) To UBound(Tabuniq, 1)
If Vardatas(K, 1) = Tabuniq(Kf, 1) Then
Feuil3.Cells(Kf + Limita, 2) = Vardatas(K, 2)
Feuil3.Cells(Kf + Limita, 3) = Vardatas(K, 3)
Feuil3.Cells(Kf + Limita, 4) = Vardatas(K, 4)
Feuil3.Cells(Kf + Limita, Vcol) = Vardatas(K, Vcol)
End If
Next Kf
Next K
Erase Tablo: Erase Vardatas: Erase Tabuniq
Set RngA = Nothing: Set RngB = Nothing
End Sub
Avatar
vdenis3399
Salut Starwing,

il y a un prob dans la formule au niveau :

For Kf = LBound(Tabuniq, 1) To UBound(Tabuniq, 1) , j ai un message d
erreur qui me propose de débboguer.

Désolé mais je ne suis vraiment pas un expert dans les macros.

Merci, Denis

"Starwing" a écrit :

Option Explicit
Const Vcol As Long = 5 'Vérifie 5 premieres colonnes

Sub Itemsdifferents()
Application.ScreenUpdating = False
Dim RngA As Range, RngB As Range, Cll As Range
Dim K&, Ka&, Kb&, Kf&, Rw&, Cola&, Colb&, Limita&
Dim Tablo(), Tabuniq As Variant, Vardatas As Variant
Ka = Feuil1.Cells(65536, 1).End(xlUp).Row
Kb = Feuil2.Cells(65536, 1).End(xlUp).Row
Cola = 1: Colb = 1
Feuil3.Cells.ClearContents
Set RngA = Feuil1.Range("A2").Resize(Ka, 1)
Set RngB = Feuil2.Range("A2").Resize(Kb, 1)
ReDim Tablo(1 To Ka + Kb, 1)
Rw = 1
For Each Cll In RngB
If Application.CountIf(RngA, Cll.Value) = 0 Then
Tablo(Rw, 1) = Cll.Value
Rw = Rw + 1
End If
Next
Limita = Rw - 1
Rw = Rw - 1

For Each Cll In RngA
If Application.CountIf(RngB, Cll.Value) = 0 Then
Tablo(Rw, 1) = Cll.Value
Rw = Rw + 1
End If
Next

Feuil3.Cells(1, 1) = Feuil1.Cells(1, 1)
For Rw = LBound(Tablo) To Limita
Feuil3.Cells(Rw + 1, Cola) = Tablo(Rw, 1)
Next

Tabuniq = Feuil3.Cells(1, Cola).Resize(Limita, Cola).Value
Vardatas = Feuil2.Cells(1, Colb).Resize(Kb, Vcol).Value

For K = LBound(Vardatas) To UBound(Vardatas)
For Kf = LBound(Tabuniq, 1) To UBound(Tabuniq, 1)
If Vardatas(K, 1) = Tabuniq(Kf, 1) Then
Feuil3.Cells(Kf, 2) = Vardatas(K, 2)
Feuil3.Cells(Kf, 3) = Vardatas(K, 3)
Feuil3.Cells(Kf, 4) = Vardatas(K, 4)
Feuil3.Cells(Kf, Vcol) = Vardatas(K, Vcol)
End If
Next Kf
Next K
Erase Vardatas
Erase Tabuniq

For Rw = Limita + 1 To UBound(Tablo)

Feuil3.Cells(Rw + 1, Cola) = Tablo(Rw, 1)
Next

Vardatas = Feuil1.Cells(1, Cola).Resize(Ka, Vcol).Value
Tabuniq = Feuil3.Cells(Limita + 1, Cola).Resize(Rw, Cola).Value

For K = LBound(Vardatas) To UBound(Vardatas)
For Kf = LBound(Tabuniq, 1) To UBound(Tabuniq, 1)
If Vardatas(K, 1) = Tabuniq(Kf, 1) Then
Feuil3.Cells(Kf + Limita, 2) = Vardatas(K, 2)
Feuil3.Cells(Kf + Limita, 3) = Vardatas(K, 3)
Feuil3.Cells(Kf + Limita, 4) = Vardatas(K, 4)
Feuil3.Cells(Kf + Limita, Vcol) = Vardatas(K, Vcol)
End If
Next Kf
Next K
Erase Tablo: Erase Vardatas: Erase Tabuniq
Set RngA = Nothing: Set RngB = Nothing
End Sub





Avatar
vdenis3399
Bonjour Starwing,

Il y a un prob dans la formule au niveau de cette ligne :

For Kf = LBound(Tabuniq, 1) To UBound(Tabuniq, 1)

La macro ne s excécute pas et me surligne la ligne ci-dessus en erreur.

Désolé je ne suis pas un expert en macro

Merci, Denis

"Starwing" a écrit :

Option Explicit
Const Vcol As Long = 5 'Vérifie 5 premieres colonnes

Sub Itemsdifferents()
Application.ScreenUpdating = False
Dim RngA As Range, RngB As Range, Cll As Range
Dim K&, Ka&, Kb&, Kf&, Rw&, Cola&, Colb&, Limita&
Dim Tablo(), Tabuniq As Variant, Vardatas As Variant
Ka = Feuil1.Cells(65536, 1).End(xlUp).Row
Kb = Feuil2.Cells(65536, 1).End(xlUp).Row
Cola = 1: Colb = 1
Feuil3.Cells.ClearContents
Set RngA = Feuil1.Range("A2").Resize(Ka, 1)
Set RngB = Feuil2.Range("A2").Resize(Kb, 1)
ReDim Tablo(1 To Ka + Kb, 1)
Rw = 1
For Each Cll In RngB
If Application.CountIf(RngA, Cll.Value) = 0 Then
Tablo(Rw, 1) = Cll.Value
Rw = Rw + 1
End If
Next
Limita = Rw - 1
Rw = Rw - 1

For Each Cll In RngA
If Application.CountIf(RngB, Cll.Value) = 0 Then
Tablo(Rw, 1) = Cll.Value
Rw = Rw + 1
End If
Next

Feuil3.Cells(1, 1) = Feuil1.Cells(1, 1)
For Rw = LBound(Tablo) To Limita
Feuil3.Cells(Rw + 1, Cola) = Tablo(Rw, 1)
Next

Tabuniq = Feuil3.Cells(1, Cola).Resize(Limita, Cola).Value
Vardatas = Feuil2.Cells(1, Colb).Resize(Kb, Vcol).Value

For K = LBound(Vardatas) To UBound(Vardatas)
For Kf = LBound(Tabuniq, 1) To UBound(Tabuniq, 1)
If Vardatas(K, 1) = Tabuniq(Kf, 1) Then
Feuil3.Cells(Kf, 2) = Vardatas(K, 2)
Feuil3.Cells(Kf, 3) = Vardatas(K, 3)
Feuil3.Cells(Kf, 4) = Vardatas(K, 4)
Feuil3.Cells(Kf, Vcol) = Vardatas(K, Vcol)
End If
Next Kf
Next K
Erase Vardatas
Erase Tabuniq

For Rw = Limita + 1 To UBound(Tablo)

Feuil3.Cells(Rw + 1, Cola) = Tablo(Rw, 1)
Next

Vardatas = Feuil1.Cells(1, Cola).Resize(Ka, Vcol).Value
Tabuniq = Feuil3.Cells(Limita + 1, Cola).Resize(Rw, Cola).Value

For K = LBound(Vardatas) To UBound(Vardatas)
For Kf = LBound(Tabuniq, 1) To UBound(Tabuniq, 1)
If Vardatas(K, 1) = Tabuniq(Kf, 1) Then
Feuil3.Cells(Kf + Limita, 2) = Vardatas(K, 2)
Feuil3.Cells(Kf + Limita, 3) = Vardatas(K, 3)
Feuil3.Cells(Kf + Limita, 4) = Vardatas(K, 4)
Feuil3.Cells(Kf + Limita, Vcol) = Vardatas(K, Vcol)
End If
Next Kf
Next K
Erase Tablo: Erase Vardatas: Erase Tabuniq
Set RngA = Nothing: Set RngB = Nothing
End Sub





Avatar
vdenis3399
désolé.... j ai compris le prob... tout marche super bien... un gros merci
starwing

"Starwing" a écrit :

Option Explicit
Const Vcol As Long = 5 'Vérifie 5 premieres colonnes

Sub Itemsdifferents()
Application.ScreenUpdating = False
Dim RngA As Range, RngB As Range, Cll As Range
Dim K&, Ka&, Kb&, Kf&, Rw&, Cola&, Colb&, Limita&
Dim Tablo(), Tabuniq As Variant, Vardatas As Variant
Ka = Feuil1.Cells(65536, 1).End(xlUp).Row
Kb = Feuil2.Cells(65536, 1).End(xlUp).Row
Cola = 1: Colb = 1
Feuil3.Cells.ClearContents
Set RngA = Feuil1.Range("A2").Resize(Ka, 1)
Set RngB = Feuil2.Range("A2").Resize(Kb, 1)
ReDim Tablo(1 To Ka + Kb, 1)
Rw = 1
For Each Cll In RngB
If Application.CountIf(RngA, Cll.Value) = 0 Then
Tablo(Rw, 1) = Cll.Value
Rw = Rw + 1
End If
Next
Limita = Rw - 1
Rw = Rw - 1

For Each Cll In RngA
If Application.CountIf(RngB, Cll.Value) = 0 Then
Tablo(Rw, 1) = Cll.Value
Rw = Rw + 1
End If
Next

Feuil3.Cells(1, 1) = Feuil1.Cells(1, 1)
For Rw = LBound(Tablo) To Limita
Feuil3.Cells(Rw + 1, Cola) = Tablo(Rw, 1)
Next

Tabuniq = Feuil3.Cells(1, Cola).Resize(Limita, Cola).Value
Vardatas = Feuil2.Cells(1, Colb).Resize(Kb, Vcol).Value

For K = LBound(Vardatas) To UBound(Vardatas)
For Kf = LBound(Tabuniq, 1) To UBound(Tabuniq, 1)
If Vardatas(K, 1) = Tabuniq(Kf, 1) Then
Feuil3.Cells(Kf, 2) = Vardatas(K, 2)
Feuil3.Cells(Kf, 3) = Vardatas(K, 3)
Feuil3.Cells(Kf, 4) = Vardatas(K, 4)
Feuil3.Cells(Kf, Vcol) = Vardatas(K, Vcol)
End If
Next Kf
Next K
Erase Vardatas
Erase Tabuniq

For Rw = Limita + 1 To UBound(Tablo)

Feuil3.Cells(Rw + 1, Cola) = Tablo(Rw, 1)
Next

Vardatas = Feuil1.Cells(1, Cola).Resize(Ka, Vcol).Value
Tabuniq = Feuil3.Cells(Limita + 1, Cola).Resize(Rw, Cola).Value

For K = LBound(Vardatas) To UBound(Vardatas)
For Kf = LBound(Tabuniq, 1) To UBound(Tabuniq, 1)
If Vardatas(K, 1) = Tabuniq(Kf, 1) Then
Feuil3.Cells(Kf + Limita, 2) = Vardatas(K, 2)
Feuil3.Cells(Kf + Limita, 3) = Vardatas(K, 3)
Feuil3.Cells(Kf + Limita, 4) = Vardatas(K, 4)
Feuil3.Cells(Kf + Limita, Vcol) = Vardatas(K, Vcol)
End If
Next Kf
Next K
Erase Tablo: Erase Vardatas: Erase Tabuniq
Set RngA = Nothing: Set RngB = Nothing
End Sub





Avatar
Starwing
Bienvenue,

"vdenis3399" a écrit dans le message
de news:
désolé.... j ai compris le prob... tout marche super bien... un gros merci
starwing

"Starwing" a écrit :

Option Explicit
Const Vcol As Long = 5 'Vérifie 5 premieres colonnes

Sub Itemsdifferents()
Application.ScreenUpdating = False
Dim RngA As Range, RngB As Range, Cll As Range
Dim K&, Ka&, Kb&, Kf&, Rw&, Cola&, Colb&, Limita&
Dim Tablo(), Tabuniq As Variant, Vardatas As Variant
Ka = Feuil1.Cells(65536, 1).End(xlUp).Row
Kb = Feuil2.Cells(65536, 1).End(xlUp).Row
Cola = 1: Colb = 1
Feuil3.Cells.ClearContents
Set RngA = Feuil1.Range("A2").Resize(Ka, 1)
Set RngB = Feuil2.Range("A2").Resize(Kb, 1)
ReDim Tablo(1 To Ka + Kb, 1)
Rw = 1
For Each Cll In RngB
If Application.CountIf(RngA, Cll.Value) = 0 Then
Tablo(Rw, 1) = Cll.Value
Rw = Rw + 1
End If
Next
Limita = Rw - 1
Rw = Rw - 1

For Each Cll In RngA
If Application.CountIf(RngB, Cll.Value) = 0 Then
Tablo(Rw, 1) = Cll.Value
Rw = Rw + 1
End If
Next

Feuil3.Cells(1, 1) = Feuil1.Cells(1, 1)
For Rw = LBound(Tablo) To Limita
Feuil3.Cells(Rw + 1, Cola) = Tablo(Rw, 1)
Next

Tabuniq = Feuil3.Cells(1, Cola).Resize(Limita, Cola).Value
Vardatas = Feuil2.Cells(1, Colb).Resize(Kb, Vcol).Value

For K = LBound(Vardatas) To UBound(Vardatas)
For Kf = LBound(Tabuniq, 1) To UBound(Tabuniq, 1)
If Vardatas(K, 1) = Tabuniq(Kf, 1) Then
Feuil3.Cells(Kf, 2) = Vardatas(K, 2)
Feuil3.Cells(Kf, 3) = Vardatas(K, 3)
Feuil3.Cells(Kf, 4) = Vardatas(K, 4)
Feuil3.Cells(Kf, Vcol) = Vardatas(K, Vcol)
End If
Next Kf
Next K
Erase Vardatas
Erase Tabuniq

For Rw = Limita + 1 To UBound(Tablo)

Feuil3.Cells(Rw + 1, Cola) = Tablo(Rw, 1)
Next

Vardatas = Feuil1.Cells(1, Cola).Resize(Ka, Vcol).Value
Tabuniq = Feuil3.Cells(Limita + 1, Cola).Resize(Rw, Cola).Value

For K = LBound(Vardatas) To UBound(Vardatas)
For Kf = LBound(Tabuniq, 1) To UBound(Tabuniq, 1)
If Vardatas(K, 1) = Tabuniq(Kf, 1) Then
Feuil3.Cells(Kf + Limita, 2) = Vardatas(K, 2)
Feuil3.Cells(Kf + Limita, 3) = Vardatas(K, 3)
Feuil3.Cells(Kf + Limita, 4) = Vardatas(K, 4)
Feuil3.Cells(Kf + Limita, Vcol) = Vardatas(K, Vcol)
End If
Next Kf
Next K
Erase Tablo: Erase Vardatas: Erase Tabuniq
Set RngA = Nothing: Set RngB = Nothing
End Sub