Problème fonction recherche VBA excel 2003
djam
-
tachounette -
tachounette -
Bonjour,
j'ai un script VBA dont le résultat s'affiche sur la feuille "suivi conso" en Cellule A5. Et je voudrais que mon résultat s'affiche à partir de la cellule A8.
Voici le script :
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
x = 1
y = 5
Do
.Cells(y, 1).Value = data(x)
y = y + 1
x = x + 1
Loop Until data(x) = ""
End With
End Sub
j'ai un script VBA dont le résultat s'affiche sur la feuille "suivi conso" en Cellule A5. Et je voudrais que mon résultat s'affiche à partir de la cellule A8.
Voici le script :
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
x = 1
y = 5
Do
.Cells(y, 1).Value = data(x)
y = y + 1
x = x + 1
Loop Until data(x) = ""
End With
End Sub
A voir également:
- Problème fonction recherche VBA excel 2003
- Fonction si et excel - Guide
- Liste déroulante excel - Guide
- Word et excel gratuit - Guide
- Recherche automatique des chaînes ne fonctionne pas - Guide
- Fonction moyenne excel - Guide
3 réponses
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
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?