Logo GNT
Actualités Tests & Guides Bons Plans
Twitter iPhone pliant OnePlus 11 PS5 Disney+ Orange Livebox Windows 11
Entraide Applications Microsoft Office Excel Comparaison de feuilles

Comparaison de feuilles

32 réponses
Avatar
Jacquouille
Bonsoir,

Soit un fichier avec au minimum 12 feuilles (janv, févr...) construites de
la même manière:
N° membre Titre NOM RUE CP LOCALITE Tél. Email Choix
d'envoi
Chaque feuille a entre 400 et 500 noms de membres.
Chaque mois, des membres partent et des nouveaux arrivent.
Pour les partants, pas de prob car leur nom n'apparait plus le mois suivant.

Afin d'isoler les nouveaux membres, j'aimerais comparer la feuille de Fév
avec celle de Janvier.
Ensuite, créer une nouvelle feuille (Nouveaux Fév) sur laquelle on
retrouverait la même construction, mais uniquement pour les nouveaux
membres. C'est à dire, supprimer tous les noms de Fév qui sont en Janv. de
cette manière, il n'y aurait plus que les nouveaux.

Cerise: en lançant la macro, une "inpute-box" demanderait "pour quel mois on
veut les nouv membres". Ce inputbox servirait aussi à nommer la nouvelle
feuille créée.

Voilà 4 jours que je galère là-dessus et d'une fois à l'autre, cela va
moins bien.....
Vous comprenez aisément mon désarroi.

Grand merci et que le Grand Saint Nicolas vous apporte à tous et toutes ce
dont vous rêvez?
Perso, ce serait une machine à macros. -))

Jacques
" Le vin est au repas ce que le parfum est à la femme."
.


---
L'absence de virus dans ce courrier électronique a été vérifiée par le logiciel antivirus Avast.
http://www.avast.com
Signaler un problème avec ce contenu

10 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
1 2 3 4
Avatar
Patrick
Hello, Jacques,

un essai ici sur 2 mois ici :)

http://www.cjoint.com/c/ELgqRqzGZlH

à toi de voir :)

P.

Le 6/12/2015 15:05, Jacquouille a écrit :
Bonjour Denis

J'ai testé ta macro.
J'ai posé arbitrairement derCol à 10 car calculé sur la ligne des
titres(ligne 1) car, des fois, il n'y a pas de données pour cette colonne.

Non seulement, elle copie bien les nouveaux membres (en ligne complète),
mais, curieusement, elle m'ajoute la dernière ligne de Févr. ????

C'est grâve, docteur?
Vois ici:

http://www.cjoint.com/c/ELgocSWOaKn

Merci et bonne St Nicolas

Jacques
" Le vin est au repas ce que le parfum est à la femme."
.
"MichD" a écrit dans le message de groupe de discussion :
n3uu37$2t4$

Une version améliorée : http://www.cjoint.com/c/ELfo56J3vOG

---
L'absence de virus dans ce courrier électronique a été vérifiée par le
logiciel antivirus Avast.
http://www.avast.com





---
L'absence de virus dans ce courrier électronique a été vérifiée par le logiciel antivirus Avast.
https://www.avast.com/antivirus
Avatar
MichD
La procédure fonctionne correctement. Cependant, il serait prudent d'ajouter
cette ligne de code afin d'effacer tout le contenu de la feuille "Résultat" lors
du lancement de la procédure.

Avec correction apportée, la nouvelle procédure

'--------------------------------------------------------------------------------------------
Sub test_Denis()
Dim Rg As Range, F As Worksheet, F2 As Worksheet
Dim Adr As String, F3 As Worksheet, Col As Long

Application.ScreenUpdating = False
Application.EnableEvents = False

Set F = Worksheets("Janv")
Set F2 = Worksheets("Févr")
Set F3 = Worksheets("Résultat")

F3.Cells.Clear 'La ligne ajoutée

With F
Adr = .Name & "!" & .Range("A2:A" & .Range("A" & .Rows.Count).End(xlUp).Row).Address
Col = .Range("A1").CurrentRegion.Columns.Count ' ---> = 10 car calculé sur ligne des titres
(ligne1) qui sera toujours = 10
End With

With F2
Set Rg = .Range("A2:A" & .Range("A" & .Rows.Count).End(xlUp).Row)
End With

With Rg
.Offset(, Col).Formula = "=CountIf(" & Adr & "," & .Item(1, 1).Address(0, 0) & ")"
.Offset(, Col).Value = .Offset(, Col).Value
.Offset(-1, Col).AutoFilter field:=1, Criteria1:=0
.Offset(-1, Col).Resize(.Rows.Count + 1).SpecialCells(xlCellTypeVisible).EntireRow.Copy
Feuil3.Range("A1")
.Offset(, Col).AutoFilter
.Offset(, Col).Clear
With F3
x = .Range("A1").CurrentRegion.Columns.Count
.Columns(x).Clear
End With
End With
Application.ScreenUpdating = True
Application.EnableEvents = True

End Sub
'--------------------------------------------------------------------------------------------
Avatar
Patrick
C'est une autre façon de faire:)
Jacques devrait trouver son bonheur en y mettant un peu les mains dans
le cambouis :)

Bonne soirée à tous

Patrick


---
L'absence de virus dans ce courrier électronique a été vérifiée par le logiciel antivirus Avast.
https://www.avast.com/antivirus
Avatar
Jacquouille
Re
Merci pour le temps que tu me consacres.
Mais, je suis désolé, la macro copie bien les 2 lignes des 2 nouveaux
membres, mais, en plus, la dernière ligne de la feuille du mois de février.
Et ça, j'ai beau mettre la main dans le cambouis, je ne pige pas.


Jacques
" Le vin est au repas ce que le parfum est à la femme."
.
"MichD" a écrit dans le message de groupe de discussion :
n41tt2$cjq$


La procédure fonctionne correctement. Cependant, il serait prudent d'ajouter
cette ligne de code afin d'effacer tout le contenu de la feuille "Résultat"
lors
du lancement de la procédure.

Avec correction apportée, la nouvelle procédure

'--------------------------------------------------------------------------------------------
Sub test_Denis()
Dim Rg As Range, F As Worksheet, F2 As Worksheet
Dim Adr As String, F3 As Worksheet, Col As Long

Application.ScreenUpdating = False
Application.EnableEvents = False

Set F = Worksheets("Janv")
Set F2 = Worksheets("Févr")
Set F3 = Worksheets("Résultat")

F3.Cells.Clear 'La ligne ajoutée

With F
Adr = .Name & "!" & .Range("A2:A" & .Range("A" &
.Rows.Count).End(xlUp).Row).Address
Col = .Range("A1").CurrentRegion.Columns.Count ' ---> = 10 car calculé
sur ligne des titres
(ligne1) qui sera toujours = 10
End With

With F2
Set Rg = .Range("A2:A" & .Range("A" & .Rows.Count).End(xlUp).Row)
End With

With Rg
.Offset(, Col).Formula = "=CountIf(" & Adr & "," & .Item(1,
1).Address(0, 0) & ")"
.Offset(, Col).Value = .Offset(, Col).Value
.Offset(-1, Col).AutoFilter field:=1, Criteria1:=0
.Offset(-1, Col).Resize(.Rows.Count +
1).SpecialCells(xlCellTypeVisible).EntireRow.Copy
Feuil3.Range("A1")
.Offset(, Col).AutoFilter
.Offset(, Col).Clear
With F3
x = .Range("A1").CurrentRegion.Columns.Count
.Columns(x).Clear
End With
End With
Application.ScreenUpdating = True
Application.EnableEvents = True

End Sub
'--------------------------------------------------------------------------------------------


---
L'absence de virus dans ce courrier électronique a été vérifiée par le logiciel antivirus Avast.
http://www.avast.com
Avatar
Patrick
Une petite dernière pour la route, Jacques:)

Sub Compare2Feuilles() ' PMK 2015 sur base d'un code du "grand chaman"
Dim ar1, ar2, arCol
Dim Dico
Dim i As Long, z As Long, k As Long, n As Long
Dim col As String, temp As String
Dim Question As String
ar1 = Sheets(1).Cells(1).CurrentRegion
ar2 = Sheets(2).Cells(2).CurrentRegion
Set Dico = CreateObject("Scripting.Dictionary")
' / Contruire tableau avec les numéros de colonnes
Question = InputBox("[1] Trouver les communs [2] Trouver les nouveaux")
If Question = "" Then Exit Sub
ReDim arCol(0 To UBound(ar1, 2) - 1)
For i = 0 To UBound(ar1, 2) - 1
arCol(i) = i + 1
Next i
' / Créer un dictionnaire des valeurs à comparer
For i = 2 To UBound(ar1, 1)
temp = ""
For k = 0 To UBound(arCol)
temp = temp & ar1(i, arCol(k)) & Chr(2)
Next k
If Not Dico.Exists(temp) Then Dico.Add temp, i
Next i
' / Avec les données de la feuille2, vérifier si existe dans le dictionnaire
n = 2
For i = 2 To UBound(ar2, 1)
temp = ""
For k = 0 To UBound(arCol)
temp = temp & ar2(i, arCol(k)) & Chr(2)
Next k
Choix = IIf(Question = "1", Dico.Exists(temp), Not Dico.Exists(temp))
' choix permet de choisir si on garde 1 les communs ou 2 les nouveaux
If Choix Then 'si existe, écrire dans le tableau
For z = 1 To UBound(ar2, 2)
ar1(n, z) = ar2(i, z)
Next z
n = n + 1
End If
Next i
' / Écrire les résultats dans la 3e feuille
With Sheets(3).Cells(1)
.CurrentRegion.Clear
.Resize(n - 1, UBound(ar1, 2)) = ar1
End With
Exit Sub
End Sub




---
L'absence de virus dans ce courrier électronique a été vérifiée par le logiciel antivirus Avast.
https://www.avast.com/antivirus
Avatar
Jacquouille
Re
Je lis ceci:
Set Rg = .Range("A2:A" & .Range("A" & .Rows.Count).End(xlUp).Row)
Ce code, ne compte-t-il pas la ligne de titre?
Si oui, la plage ("A2:A"& nombre de lignes) aura une ligne en +
Ne serait-ce pas celle-là qu'il me recopie?



Jacques
" Le vin est au repas ce que le parfum est à la femme."
.
"Jacquouille" a écrit dans le message de groupe de discussion :
n426r4$71o$

Re
Merci pour le temps que tu me consacres.
Mais, je suis désolé, la macro copie bien les 2 lignes des 2 nouveaux
membres, mais, en plus, la dernière ligne de la feuille du mois de février.
Et ça, j'ai beau mettre la main dans le cambouis, je ne pige pas.


Jacques
" Le vin est au repas ce que le parfum est à la femme."
.
"MichD" a écrit dans le message de groupe de discussion :
n41tt2$cjq$


La procédure fonctionne correctement. Cependant, il serait prudent d'ajouter
cette ligne de code afin d'effacer tout le contenu de la feuille "Résultat"
lors
du lancement de la procédure.

Avec correction apportée, la nouvelle procédure

'--------------------------------------------------------------------------------------------
Sub test_Denis()
Dim Rg As Range, F As Worksheet, F2 As Worksheet
Dim Adr As String, F3 As Worksheet, Col As Long

Application.ScreenUpdating = False
Application.EnableEvents = False

Set F = Worksheets("Janv")
Set F2 = Worksheets("Févr")
Set F3 = Worksheets("Résultat")

F3.Cells.Clear 'La ligne ajoutée

With F
Adr = .Name & "!" & .Range("A2:A" & .Range("A" &
.Rows.Count).End(xlUp).Row).Address
Col = .Range("A1").CurrentRegion.Columns.Count ' ---> = 10 car calculé
sur ligne des titres
(ligne1) qui sera toujours = 10
End With

With F2
Set Rg = .Range("A2:A" & .Range("A" & .Rows.Count).End(xlUp).Row)
End With

With Rg
.Offset(, Col).Formula = "=CountIf(" & Adr & "," & .Item(1,
1).Address(0, 0) & ")"
.Offset(, Col).Value = .Offset(, Col).Value
.Offset(-1, Col).AutoFilter field:=1, Criteria1:=0
.Offset(-1, Col).Resize(.Rows.Count +
1).SpecialCells(xlCellTypeVisible).EntireRow.Copy
Feuil3.Range("A1")
.Offset(, Col).AutoFilter
.Offset(, Col).Clear
With F3
x = .Range("A1").CurrentRegion.Columns.Count
.Columns(x).Clear
End With
End With
Application.ScreenUpdating = True
Application.EnableEvents = True

End Sub
'--------------------------------------------------------------------------------------------


---
L'absence de virus dans ce courrier électronique a été vérifiée par le
logiciel antivirus Avast.
http://www.avast.com


---
L'absence de virus dans ce courrier électronique a été vérifiée par le logiciel antivirus Avast.
http://www.avast.com
Avatar
MichD
Publie le classeur dans lequel tu obtiens un résultat erroné en soulignant la ou les données
erronées.
Avatar
Jacquouille
Salut Pat

Me trouve 16 nouveaux, alors qu'il n'y en a que 7 dans toute ma liste de 400
membres.
Dés.
mais merci de t'être penché sur mon cas


Jacques
" Le vin est au repas ce que le parfum est à la femme."
.
"Patrick" a écrit dans le message de groupe de discussion :
n428cn$b9u$

Une petite dernière pour la route, Jacques:)

Sub Compare2Feuilles() ' PMK 2015 sur base d'un code du "grand chaman"
Dim ar1, ar2, arCol
Dim Dico
Dim i As Long, z As Long, k As Long, n As Long
Dim col As String, temp As String
Dim Question As String
ar1 = Sheets(1).Cells(1).CurrentRegion
ar2 = Sheets(2).Cells(2).CurrentRegion
Set Dico = CreateObject("Scripting.Dictionary")
' / Contruire tableau avec les numéros de colonnes
Question = InputBox("[1] Trouver les communs [2] Trouver les nouveaux")
If Question = "" Then Exit Sub
ReDim arCol(0 To UBound(ar1, 2) - 1)
For i = 0 To UBound(ar1, 2) - 1
arCol(i) = i + 1
Next i
' / Créer un dictionnaire des valeurs à comparer
For i = 2 To UBound(ar1, 1)
temp = ""
For k = 0 To UBound(arCol)
temp = temp & ar1(i, arCol(k)) & Chr(2)
Next k
If Not Dico.Exists(temp) Then Dico.Add temp, i
Next i
' / Avec les données de la feuille2, vérifier si existe dans le dictionnaire
n = 2
For i = 2 To UBound(ar2, 1)
temp = ""
For k = 0 To UBound(arCol)
temp = temp & ar2(i, arCol(k)) & Chr(2)
Next k
Choix = IIf(Question = "1", Dico.Exists(temp), Not Dico.Exists(temp))
' choix permet de choisir si on garde 1 les communs ou 2 les nouveaux
If Choix Then 'si existe, écrire dans le tableau
For z = 1 To UBound(ar2, 2)
ar1(n, z) = ar2(i, z)
Next z
n = n + 1
End If
Next i
' / Écrire les résultats dans la 3e feuille
With Sheets(3).Cells(1)
.CurrentRegion.Clear
.Resize(n - 1, UBound(ar1, 2)) = ar1
End With
Exit Sub
End Sub




---
L'absence de virus dans ce courrier électronique a été vérifiée par le
logiciel antivirus Avast.
https://www.avast.com/antivirus


---
L'absence de virus dans ce courrier électronique a été vérifiée par le logiciel antivirus Avast.
http://www.avast.com
Avatar
Jacquouille
Bonsoir Denis

C'est le même classeur que celui que j'ai envoyé.
La troisième ligne de la feuille "résultat" est erronée car elle se retrouve
dans les 2 mois.
J'ai refait le test avec les bonnes données pour les 2 mois (400) et la même
erreur apparait, à savoir la dernière ligne du mois de déc.
Si tu le désires, je peux t'envoyer le doc complet chez toi.

Jacques
" Le vin est au repas ce que le parfum est à la femme."
.
"MichD" a écrit dans le message de groupe de discussion :
n42967$dqb$

Publie le classeur dans lequel tu obtiens un résultat erroné en soulignant
la ou les données
erronées.




---
L'absence de virus dans ce courrier électronique a été vérifiée par le logiciel antivirus Avast.
http://www.avast.com
Avatar
MichD
Dans le fichier que tu as publié, j'ai exécuté la macro et je n'obtiens que
2 lignes de données dans la feuille résultat. Tout est OK.

Il doit avoir quelque chose que tu ne dis pas...
1 2 3 4