XL 2016 comparaison de deux Plages

KTM

XLDnaute Occasionnel
Salut chers tous
J'ai une plage de données 1 et une plage de données 2
J'aimerais par macro extraire sur une plage 3 les personnes enregistrées sur la plage 1 et qui ne sont pas sur la plage 2
Merci
 

Fichiers joints

Calvus

XLDnaute Barbatruc
Bonjour,

Voici.
VB:
Sub Extraire()
Dim i As Integer, n As Single, t, a()

t = Range("A1:B16")
ReDim a(1 To UBound(t), 2)
For i = 1 To Cells(Rows.Count, 1).End(xlUp).Row
If WorksheetFunction.CountIf(Columns(4), Cells(i + 4, 1)) = 0 Then
n = n + 1
a(n, 1) = Cells(i + 4, 1)
a(n, 2) = Cells(i + 4, 2)
End If
Next i
[G5].Resize(UBound(a, 1), 2) = a
End Sub
J'ai mis la macro sur le bouton Extraire

A+
 

Fichiers joints

KTM

XLDnaute Occasionnel
Bonjour,

Voici.
VB:
Sub Extraire()
Dim i As Integer, n As Single, t, a()

t = Range("A1:B16")
ReDim a(1 To UBound(t), 2)
For i = 1 To Cells(Rows.Count, 1).End(xlUp).Row
If WorksheetFunction.CountIf(Columns(4), Cells(i + 4, 1)) = 0 Then
n = n + 1
a(n, 1) = Cells(i + 4, 1)
a(n, 2) = Cells(i + 4, 2)
End If
Next i
[G5].Resize(UBound(a, 1), 2) = a
End Sub
J'ai mis la macro sur le bouton Extraire

A+
Merci Enormement ça marche
Mais si c'est pas trop demander j'aimerais que vous apportez quelques commentaires afin que je puisse adapter la macro a d'autres situations.
J'ai aussi vu "Option Base 1" qui est pour moi une decouverte
Merci Encore et Encore
 

Calvus

XLDnaute Barbatruc
Re,


VB:
Sub Extraire()
Dim i As Integer, n As Single, t, a()'Déclarations des variables'

t = Range("A1:B16")'On sélectionne le tableau sur lequel se fait la recherche'
ReDim a(1 To UBound(t), 2)'On crée un nouveau tableau qui prendra les valeurs cherchées'
For i = 1 To Cells(Rows.Count, 1).End(xlUp).Row'Pour toutes les lignes non vides
If WorksheetFunction.CountIf(Columns(4), Cells(i + 4, 1)) = 0 Then'Si la colonne 4 ne contient pas les cellules de la colonne 1
n = n + 1'On incrémente un compteur
a(n, 1) = Cells(i + 4, 1)'1ère valeur de la colonne 1, etc...'
a(n, 2) = Cells(i + 4, 2)'1ère valeur de la colonne 2, etc...
End If
Next i'On passe à la ligne suivante
[G5].Resize(UBound(a, 1), 2) = a'On inscrit les données trouvées
End Sub
Option Base 1 sinon Excel compte à partir de 0

Voilà, j'espère que c'est clair.

A+
 

KTM

XLDnaute Occasionnel
Re,


VB:
Sub Extraire()
Dim i As Integer, n As Single, t, a()'Déclarations des variables'

t = Range("A1:B16")'On sélectionne le tableau sur lequel se fait la recherche'
ReDim a(1 To UBound(t), 2)'On crée un nouveau tableau qui prendra les valeurs cherchées'
For i = 1 To Cells(Rows.Count, 1).End(xlUp).Row'Pour toutes les lignes non vides
If WorksheetFunction.CountIf(Columns(4), Cells(i + 4, 1)) = 0 Then'Si la colonne 4 ne contient pas les cellules de la colonne 1
n = n + 1'On incrémente un compteur
a(n, 1) = Cells(i + 4, 1)'1ère valeur de la colonne 1, etc...'
a(n, 2) = Cells(i + 4, 2)'1ère valeur de la colonne 2, etc...
End If
Next i'On passe à la ligne suivante
[G5].Resize(UBound(a, 1), 2) = a'On inscrit les données trouvées
End Sub
Option Base 1 sinon Excel compte à partir de 0

Voilà, j'espère que c'est clair.

A+
Belle Leçon MERCI.
 

KTM

XLDnaute Occasionnel
Re,


VB:
Sub Extraire()
Dim i As Integer, n As Single, t, a()'Déclarations des variables'

t = Range("A1:B16")'On sélectionne le tableau sur lequel se fait la recherche'
ReDim a(1 To UBound(t), 2)'On crée un nouveau tableau qui prendra les valeurs cherchées'
For i = 1 To Cells(Rows.Count, 1).End(xlUp).Row'Pour toutes les lignes non vides
If WorksheetFunction.CountIf(Columns(4), Cells(i + 4, 1)) = 0 Then'Si la colonne 4 ne contient pas les cellules de la colonne 1
n = n + 1'On incrémente un compteur
a(n, 1) = Cells(i + 4, 1)'1ère valeur de la colonne 1, etc...'
a(n, 2) = Cells(i + 4, 2)'1ère valeur de la colonne 2, etc...
End If
Next i'On passe à la ligne suivante
[G5].Resize(UBound(a, 1), 2) = a'On inscrit les données trouvées
End Sub
Option Base 1 sinon Excel compte à partir de 0

Voilà, j'espère que c'est clair.

A+
Merci
J'ai essayé d'adapter la macro a une autre situation (en feuille 2) mais je pense que j'ai raté. Pouvez vous voir et me corriger ?
 

Fichiers joints

Calvus

XLDnaute Barbatruc
Re,

@KTM , je pense que cela devrait fonctionner ainsi :

VB:
Sub Ext()
Dim i As Integer, n As Single, t, a() 'Déclarations des variables'

t = Range("AV1:BG" & Range("AV" & Rows.Count).End(xlUp).Row) 'On sélectionne le tableau sur lequel se fait la recherche'
ReDim a(1 To UBound(t), 12) 'On crée un nouveau tableau qui prendra les valeurs cherchées'
For i = 1 To Cells(Rows.Count, 48).End(xlUp).Row 'Pour toutes les lignes non vides
If WorksheetFunction.CountIf(Columns(62), Cells(i + 1, 48)) = 0 Then 'Si la colonne 4 ne contient pas les cellules de la colonne 1
n = n + 1 'On incrémente un compteur
a(n, 1) = Cells(i + 1, 48)
a(n, 2) = Cells(i + 1, 49)
a(n, 3) = Cells(i + 1, 50)
a(n, 4) = Cells(i + 1, 51)
a(n, 5) = Cells(i + 1, 52)
a(n, 6) = Cells(i + 1, 53)
a(n, 7) = Cells(i + 1, 54)
a(n, 8) = Cells(i + 1, 55)
a(n, 9) = Cells(i + 1, 56)
a(n, 10) = Cells(i + 1, 57)
a(n, 11) = Cells(i + 1, 58)
a(n, 12) = Cells(i + 1, 59)
End If
Next i 'On passe à la ligne suivante
[BX2].Resize(UBound(a, 1), 12) = a 'On inscrit les données trouvées
End Sub
@chris faut il activer les connexions pour tester ton fichier ?

A+
 

chris

XLDnaute Barbatruc
oui, Powerquery est intégré mais crée des connexions.

Il y avait des liaisions sur le fichier mais ce n'est pas moi !
 

KTM

XLDnaute Occasionnel
Re,

@KTM , je pense que cela devrait fonctionner ainsi :

VB:
Sub Ext()
Dim i As Integer, n As Single, t, a() 'Déclarations des variables'

t = Range("AV1:BG" & Range("AV" & Rows.Count).End(xlUp).Row) 'On sélectionne le tableau sur lequel se fait la recherche'
ReDim a(1 To UBound(t), 12) 'On crée un nouveau tableau qui prendra les valeurs cherchées'
For i = 1 To Cells(Rows.Count, 48).End(xlUp).Row 'Pour toutes les lignes non vides
If WorksheetFunction.CountIf(Columns(62), Cells(i + 1, 48)) = 0 Then 'Si la colonne 4 ne contient pas les cellules de la colonne 1
n = n + 1 'On incrémente un compteur
a(n, 1) = Cells(i + 1, 48)
a(n, 2) = Cells(i + 1, 49)
a(n, 3) = Cells(i + 1, 50)
a(n, 4) = Cells(i + 1, 51)
a(n, 5) = Cells(i + 1, 52)
a(n, 6) = Cells(i + 1, 53)
a(n, 7) = Cells(i + 1, 54)
a(n, 8) = Cells(i + 1, 55)
a(n, 9) = Cells(i + 1, 56)
a(n, 10) = Cells(i + 1, 57)
a(n, 11) = Cells(i + 1, 58)
a(n, 12) = Cells(i + 1, 59)
End If
Next i 'On passe à la ligne suivante
[BX2].Resize(UBound(a, 1), 12) = a 'On inscrit les données trouvées
End Sub
@chris faut il activer les connexions pour tester ton fichier ?

A+
SYMPA et MERCI
 

Créez un compte ou connectez vous pour répondre

Vous devez être membre afin de pouvoir répondre ici

Créer un compte

Créez un compte Excel Downloads. C'est simple!

Connexion

Vous avez déjà un compte? Connectez vous ici.

Haut Bas