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
Merci Enormement ça marcheBonjour,
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+
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
Belle Leçon MERCI.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+
MerciRe,
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+
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
SYMPA et MERCIRe,
@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+