A voir également:
- Problème fonction recherche VBA excel 2003
- Excel fonction si et - Guide
- Liste déroulante excel - Guide
- Fonction moyenne excel - Guide
- Fonction somme excel - Guide
- Recherche automatique des chaînes ne fonctionne pas - Guide
3 réponses
Bidouilleu_R
Messages postés
1181
Date d'inscription
mardi 27 mai 2008
Statut
Membre
Dernière intervention
12 juillet 2012
293
Modifié par Bidouilleu_R le 12/07/2012 à 14:48
Modifié par Bidouilleu_R le 12/07/2012 à 14:48
ci-dessous ton code modifié!
( voir les lignes x= et Y=)
( voir les lignes x= et Y=)
Sub recherche() Dim data(500) toto = Sheets("Suivi conso").Range("c2").Value With Sheets("BASE") x = 2 y = 1 Do If .Cells(x, 1).Value = toto Then data(y) = .Cells(x, 2).Value y = y + 1 End If x = x + 1 Loop Until .Cells(x, 1).Value = "" End With With Sheets("Suivi conso") .Range("A5:A60000").ClearContents ' ici tu effaces de A5 à A60000 x = 1 ' là c'est le A y = 8 ' là c'est la ligne 8 Do .Cells(y, 1).Value = data(x) ' là l'écriture y = y + 1 x = x + 1 Loop Until data(x) = "" End With End Sub
Bidouilleu_R
Messages postés
1181
Date d'inscription
mardi 27 mai 2008
Statut
Membre
Dernière intervention
12 juillet 2012
293
12 juil. 2012 à 15:47
12 juil. 2012 à 15:47
En fait je te propose de modifier ton programme pour deux raisons:
1) le rendre plus lisible 2) l'accélerer
C'est pas plus joli comme ça?
1) le rendre plus lisible 2) l'accélerer
Sub recherche2() Dim tabData() As Variant Dim i As Integer Dim j As Integer Dim tot As Variant toto = Sheets("Suivi conso").Range("c2").Value Sheets("BASE").Select i = 0 j = 0 derlig = Range("a65000").End(xlUp).Row ' dernière ligne de la base For i = 2 To derlig If Cells(i, 1) = toto Then ReDim Preserve tabData(j) 'redimensionne en gardant les valeurs tabData(j) = Cells(i, 2).Value j = j + 1 End If Next Sheets("Suivi conso").Select derlig = Range("a65000").End(xlUp).Row ' derniere ligne dans "Suivi conso" Range("A9:A" & derlig).ClearContents ' effacement de la ligne 9 à xxx For j = 0 To UBound(tabData) Cells(9 + j, 1) = tabData(j) 'écriture de la ligne 9 à xxx Next x = MsgBox("ecriture de " & j + 1 & " valeurs", vbOKOnly, "infos") End Sub
C'est pas plus joli comme ça?