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 Accro
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 Accro
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 Accro
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
 

Discussions similaires


Haut Bas