Problème fonction recherche VBA excel 2003

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

3 réponses

  1.
    Bidouilleu_R Messages postés 1209 Statut Membre 296
     
    ci-dessous ton code modifié!
    ( 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
    1
  2. Bidouilleu_R Messages postés 1209 Statut Membre 296
     
    En fait je te propose de modifier ton programme pour deux raisons:
    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?
    0
  3. tachounette
     
    et la fonction : CTRL + F ??? ça ne fonctionne pas dans ce sens ??
    Car retenir ces formules... c'est laborieux !
    0