Boucle de recherche sur fichier Excel avec VB6, pour appli pro (Urgentisime)Résolu

Question

Bonjours à tous, 

Comme indiquer dans le titre je bosse sur une appli pro, et mon prob est la réalisation d'une boucle de recherche dans un fichier Excel avec un facteur "textbox", puis l'insertion dans une flexgrid des lignes résultats. voici mon code :

   compteur2 = 1

   Dim CellRecherche As Excel.Range

'Recherche de la 1ère cellule contenant le texte
Set CellRecherche = Cells.Find(What:=Textbox1.Text, After:=Cells(1, 1), LookIn:=xlValues, LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False)

    If Not (CellRecherche Is Nothing) Then
        
    For i = 0 To nbCols
    
    'La cellule existe
    CellRecherche.Columns(i + 1).Activate
    
    'transfert dans la flexgrid
    With MSFlexGrid3
        .Rows = compteur2 + 1
        .Col = i
        .Row = compteur2
        .Text = CellRecherche.Columns(i + 1).Value
    End With
    
    Next i        
             compteur2 = compteur2 + 1
    Else
        'Pas de cellule avec cette valeur
        MsgBox "Pas de Code correspondant"
    End If

Or ce code ne me donne que la première ligne qui contient le texte rechercher. comment puis-je obtenir une boucle qui me récupérera tte les lignes du fichier contenant le texte rechercher, sachant que le texte rechercher se trouve toujours dans la colonne A ?

Merci d'avance à tte personne pouvant me renseigner.

valtrase · Accepted Answer

Houla la j'ai besoin de faire la sièste......

[code]compteur2 = 1

Dim CellRecherche As Excel.Range
Dim MonAdresse
'Recherche de la 1ère cellule contenant le texte
Set CellRecherche = Cells.Find(What:=Textbox1.Text, After:=Cells(1, 1), LookIn:=xlValues, LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False)

If Not (CellRecherche Is Nothing) Then
'*****On Mémorise l'adresse
MonAdresse = CellRecherche.Adress
do
For i = 0 To nbCols

'***** La cellule existe
'***** en VB ce n'est pas la peine de pointer sur la cellule
'CellRecherche.Columns(i + 1).Activate

'transfert dans la flexgrid
With MSFlexGrid3
.Rows = compteur2 + 1
.Col = i
.Row = compteur2
.Text = CellRecherche.Columns(i + 1).Value
End With

Next i 
compteur2 = compteur2 + 1
Set CellRecherche = Cells.FindNext(CellRecherche)
Loop While Not CellRecherche Is Nothing And _ CellRecherche.Address <> MonAddresse

Else
'Pas de cellule avec cette valeur
MsgBox "Pas de Code correspondant"
End If
_______________________________________

Jean-Paul

Le Savoir n'a de valeur que s'il est partagé

ptite_para · Answer

c'est à cause du IF si tu sors de la boucle et que ca ne vérifie pas le reste de ta feuille.

compteur2 = 1

Dim CellRecherche As Excel.Range

'Recherche de la 1ère cellule contenant le texte
Set CellRecherche = Cells.Find(What:=Textbox1.Text, After:=Cells(1, 1), LookIn:=xlValues, LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False)

For i = 0 To nbCols

If Not (CellRecherche Is Nothing) Then

'La cellule existe
CellRecherche.Columns(i + 1).Activate

'transfert dans la flexgrid
With MSFlexGrid3
.Rows = compteur2 + 1
.Col = i
.Row = compteur2
.Text = CellRecherche.Columns(i + 1).Value
End With

End if

Next i 

If compteur2 = 1 then 
     'Pas de cellule avec cette valeur
     MsgBox "Pas de Code correspondant"
End if

g pas essayé ce code, alors j'espère ca fonctionne !

valtrase · Answer

Salut,
Si je ne m'abuse la propriété .Find te renvoie l'adresse de la première occurence pour l'insertion des autres utilise la propriété .FindNext avec un boucle Do While par exemple

_______________________________________

Jean-Paul

Le Savoir n'a de valeur que s'il est partagé

valtrase · Answer

Voilà essayes ça pour voir

compteur2 =  1

Dim CellRecherche As Excel.Range
 Dim MonAdresse 
'Recherche de la 1ère cellule contenant le texte
Set CellRecherche  = Cells.Find(What:=Textbox1.Text, After:=Cells(1, 1), LookIn:=xlValues, LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False)

If Not (CellRecherche Is Nothing) Then
'*****On Mémorise l'adresse
MonAdresse = CellRecherche.Adress
do
For i = 0 To nbCols

'***** La cellule existe
'***** en VB ce n'est pas la peine de pointer sur la cellule
'CellRecherche.Columns(i + 1).Activate

'transfert dans la flexgrid
With MSFlexGrid3
.Rows = compteur2 + 1
.Col = i
.Row = compteur2
.Text = CellRecherche.Columns(i + 1).Value
End With

Next i 
compteur2 = compteur2 + 1
CellRecherche.FindNext(CellRecherche)
Loop While Not CellRecherche Is Nothing And _ CellRecherche.Address <> MonAddresse

Else
'Pas de cellule avec cette valeur
MsgBox "Pas de Code correspondant"
End If

_______________________________________

Jean-Paul

Le Savoir n'a de valeur que s'il est partagé

Kouran666 · Answer

Tout d'abord un grand merci pour ta construction algorythmique valtrase, elle m'a bien aider dans la compréhension des lien Excel-VB. 

Mais, sans vouloir abuser de ton temps, une erreur survient lors du .FindNext. Il me dit : 

Erreur '1004' : la méthode FindNext de la classe Range à échoué.

Et il me pointe la ligne : "CellRecherche.FindNext (CellRecherche)"

Si tu pouvais m'explique ce phénomène, je t'en serais reconnaissant. Merci d'avance.

valtrase · Answer

Salut si je ne rentre pas trop tard ce soir je me pencherais sur ton code. Je te tiens au courant
_______________________________________

Jean-Paul

Le Savoir n'a de valeur que s'il est partagé

valtrase · Answer

Oups j'ai vu une petite erreur
Si ça ne marche pas avec ça dis le moi je me pencherais dessus ce soir

compteur2 = 1

Dim CellRecherche As Excel.Range
Dim MonAdresse
'Recherche de la 1ère cellule contenant le texte
Set CellRecherche = Cells.Find(What:=Textbox1.Text, After:=Cells(1, 1), LookIn:=xlValues, LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False)

If Not (CellRecherche Is Nothing) Then
'*****On Mémorise l'adresse
MonAdresse = CellRecherche.Adress
do
For i = 0 To nbCols

'***** La cellule existe
'***** en VB ce n'est pas la peine de pointer sur la cellule
'CellRecherche.Columns(i + 1).Activate

'transfert dans la flexgrid
With MSFlexGrid3
.Rows = compteur2 + 1
.Col = i
.Row = compteur2
.Text = CellRecherche.Columns(i + 1).Value
End With

Next i 
compteur2 = compteur2 + 1
 Set CellRecherche.FindNext(CellRecherche)
Loop While Not CellRecherche Is Nothing And _ CellRecherche.Address <> MonAddresse

Else
'Pas de cellule avec cette valeur
MsgBox "Pas de Code correspondant"
End If
_______________________________________________

Jean-Paul

Le Savoir n'a de valeur que s'il est partagé

Kouran666 · Answer

Grand merci à toi Valtrase !!!

cela tourne parfaitement grâce à toi, à noter 2 petites fautes de frappe dans 2 mots adresse :
1: 
"MonAdresse = CellRecherche.Address"

2:
"Loop While Not CellRecherche Is Nothing And _ CellRecherche.Address <> MonAdresse" 

sinon c'est parfait, encore merci valtrase.

valtrase · Answer

Juste un petit mot pour finir
pour optimiser ton code utilises un Objet Range à la place de Cells qui te renvoi la colection complète des cellules.

Bonne prog
_______________________________________

Jean-Paul

Le Savoir n'a de valeur que s'il est partagé

Boucle de recherche sur fichier Excel avec VB6, pour appli pro (Urgentisime)

9 réponses

Discussions similaires