Ceci est une page optimisée pour les mobiles. Cliquez sur ce texte pour afficher la vraie page.

XL 2016 Comparer deux plages

KTM

XLDnaute Impliqué
Bonjour chers Amis du Forum
J'ai une plage1 de cellules ou sont enregistrés les Personnes attendues et une autre plage2 pour les personnes recues.
Je voudrais à l'aide d'une macro extraire sur la plage3 les personnes ayant maquer de venir au Rendez vous
Je joins un fichier exemple
Merci infiniment
 

Pièces jointes

  • ComparePlage.xlsm
    11.7 KB · Affichages: 12

KTM

XLDnaute Impliqué

Pièces jointes

  • ComparePlage.xlsm
    10.6 KB · Affichages: 7

job75

XLDnaute Barbatruc
Bonjour KTM, Pierre, le forum,

Voyez le fichier joint et cette macro dans le code de la feuille :
VB:
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
If Intersect(Target, [L1]) Is Nothing Then Exit Sub
Dim deb1 As Range, deb2 As Range, d As Object, ncol%, tablo, i&, x$, j%
Cancel = True
Set deb1 = [B1]: Set deb2 = [G1]
Set d = CreateObject("Scripting.Dictionary")
d.CompareMode = vbTextCompare 'la casse est ignorée
'---liste des attendus---
With deb1.CurrentRegion.Offset(1)
    ncol = .Columns.Count
    If ncol = 1 Then ncol = 2
    tablo = .Resize(, ncol)
End With
For i = 1 To UBound(tablo)
    x = ""
    For j = 1 To ncol
        x = x & Chr(1) & tablo(i, j)
    Next j
    d(Mid(x, 2)) = ""
Next i
'---élimination des reçus---
tablo = deb2.CurrentRegion.Offset(1).Resize(, ncol)
For i = 1 To UBound(tablo)
    x = ""
    For j = 1 To ncol
        x = x & Chr(1) & tablo(i, j)
    Next j
    x = Mid(x, 2)
    If d.exists(x) Then d.Remove x
Next i
'---restitution des manquants---
Application.ScreenUpdating = False
Application.DisplayAlerts = False
If FilterMode Then ShowAllData
With Target(2, 1)
    .Resize(Rows.Count - .Row + 1, ncol).ClearContents 'RAZ
    If d.Count = 0 Then Exit Sub
    With .Resize(d.Count)
        .Value = Application.Transpose(d.keys) 'Transpose est limitée à 65536 lignes
        .TextToColumns .Cells(1), xlDelimited, Other:=True, OtherChar:=Chr(1)  'commande Convertir
    End With
End With
End Sub
Double-clic sur MANQUES.

Bonne journée.
 

Pièces jointes

  • ComparePlage(1).xlsm
    21.1 KB · Affichages: 8

KTM

XLDnaute Impliqué
Merci Job75
Super!!!
Mais je Préfère associer ce code a un bouton
Encore Merci
 

KTM

XLDnaute Impliqué
Et vous ne savez pas le faire ? Alors voyez ce fichier (2).
Je reviens encore sur ce sujet
Le code fonctionne parfaitement mais j'ai un petit soucis :
J'ai remarqué que le code est inserré dans la feuille
Jai essayé de le copier dans un module afin de faire appel dans une autre procédure mais ça coince.
Comment m'y prendre?
Merci
 

Discussions similaires

Les cookies sont requis pour utiliser ce site. Vous devez les accepter pour continuer à utiliser le site. En savoir plus…