XL 2016 comparaison de deux Plages

Calvus à dit:

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+

Cliquez pour agrandir...

Calvus à dit:

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+

Cliquez pour agrandir...

Calvus à dit:

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+

Cliquez pour agrandir...

Calvus à dit:

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+

Cliquez pour agrandir...