Problème fonction recherche vba
Résolu
avyrex1926
Messages postés
360
Date d'inscription
dimanche 3 décembre 2006
Statut
Membre
Dernière intervention
3 janvier 2012
-
27 juil. 2007 à 23:10
cs_MPi Messages postés 3877 Date d'inscription mardi 19 mars 2002 Statut Membre Dernière intervention 17 août 2018 - 28 juil. 2007 à 18:22
cs_MPi Messages postés 3877 Date d'inscription mardi 19 mars 2002 Statut Membre Dernière intervention 17 août 2018 - 28 juil. 2007 à 18:22
A voir également:
- Problème fonction recherche vba
- Doevents vba - Conseils pratiques -Visual Basic / VB.NET
- Fonction mod vba ✓ - Forum Visual Basic 6
- Maths : modulo ✓ - Forum Visual Basic
- Byval vba - Conseils pratiques -Visual Basic / VB.NET
- Modulo pour chiffres à virgule - Forum Visual Basic
27 réponses
cs_MPi
Messages postés
3877
Date d'inscription
mardi 19 mars 2002
Statut
Membre
Dernière intervention
17 août 2018
23
28 juil. 2007 à 17:09
28 juil. 2007 à 17:09
Comme tu veux remplir une listbox, tu n'as plus besoin d'utiliser un séparateur.
Je ne passe pas le contrôle Listbox en paramètre, mais ça pourrait être fait.
Private Sub CommandButton1_Click()
RechercheMot TextBox1.Text
If ListBox1.ListCount = 0 Then ListBox1.AddItem "Aucune valeur trouvée"
End Sub
Sub RechercheMot(Mot As String)
Dim I As Long, nbItems As Long, nbColonnes As Integer
Dim Recherche As Range, Adresse As String
UserForm1.ListBox1.Clear
nbColonnes = Cells.Find("*", Range("A1"), , , xlByColumns, xlPrevious).Column
'première recherche à la verticale
' «Columns("G")» peut être remplacé par «Cells»
Set Recherche = Columns("G").Find(Mot, LookAt:=xlPart, MatchCase:=False)
If Not Recherche Is Nothing Then
Adresse = Recherche.Address 'stocke l'adresse de départ
Do
'Deuxième recherche à l'horizontale
'Lire la ligne
UserForm1.ListBox1.AddItem Space(8) & "LIGNE : " & Recherche.Row
For I = 1 To nbColonnes
UserForm1.ListBox1.AddItem Cells(Recherche.Row, I)
Next
UserForm1.ListBox1.AddItem 'insère un espace
Set Recherche = Columns("G").FindNext(Recherche)
Loop Until Recherche.Address = Adresse Or Recherche Is Nothing
End If
End Sub
MPi
Je ne passe pas le contrôle Listbox en paramètre, mais ça pourrait être fait.
Private Sub CommandButton1_Click()
RechercheMot TextBox1.Text
If ListBox1.ListCount = 0 Then ListBox1.AddItem "Aucune valeur trouvée"
End Sub
Sub RechercheMot(Mot As String)
Dim I As Long, nbItems As Long, nbColonnes As Integer
Dim Recherche As Range, Adresse As String
UserForm1.ListBox1.Clear
nbColonnes = Cells.Find("*", Range("A1"), , , xlByColumns, xlPrevious).Column
'première recherche à la verticale
' «Columns("G")» peut être remplacé par «Cells»
Set Recherche = Columns("G").Find(Mot, LookAt:=xlPart, MatchCase:=False)
If Not Recherche Is Nothing Then
Adresse = Recherche.Address 'stocke l'adresse de départ
Do
'Deuxième recherche à l'horizontale
'Lire la ligne
UserForm1.ListBox1.AddItem Space(8) & "LIGNE : " & Recherche.Row
For I = 1 To nbColonnes
UserForm1.ListBox1.AddItem Cells(Recherche.Row, I)
Next
UserForm1.ListBox1.AddItem 'insère un espace
Set Recherche = Columns("G").FindNext(Recherche)
Loop Until Recherche.Address = Adresse Or Recherche Is Nothing
End If
End Sub
MPi
mortalino
Messages postés
6786
Date d'inscription
vendredi 16 décembre 2005
Statut
Membre
Dernière intervention
21 décembre 2011
18
27 juil. 2007 à 23:49
27 juil. 2007 à 23:49
c'est pas mon code ça ?
Salut Avyrex, et bien qu'est ce qui t'empêche de ne le faire que dans une seule feuille ?
Quand tu dis "mais juste dans la basse de données.", c'est donc la feuille en cours ?
@++
<hr size="2" width="100%" />( Nouveau forum : Exclusivement Office & VBA
Salut Avyrex, et bien qu'est ce qui t'empêche de ne le faire que dans une seule feuille ?
Quand tu dis "mais juste dans la basse de données.", c'est donc la feuille en cours ?
@++
<hr size="2" width="100%" />( Nouveau forum : Exclusivement Office & VBA
avyrex1926
Messages postés
360
Date d'inscription
dimanche 3 décembre 2006
Statut
Membre
Dernière intervention
3 janvier 2012
3
28 juil. 2007 à 00:09
28 juil. 2007 à 00:09
Salut mortalino,
et oui, c'est ton super code qui fonctionne mais je veux juste qu'il recherche dans la feuille en cours.
et oui, c'est ton super code qui fonctionne mais je veux juste qu'il recherche dans la feuille en cours.
mortalino
Messages postés
6786
Date d'inscription
vendredi 16 décembre 2005
Statut
Membre
Dernière intervention
21 décembre 2011
18
28 juil. 2007 à 00:17
28 juil. 2007 à 00:17
rhaa le vieux code :D
voici la fonction juste pour la feuille en cours :
Option Explicit
Public Function FindWords(ByVal sWord As String) As String()
Dim rStartCell As Range
Dim FindWord() As String
Dim i As Long: i = 0
Dim z As Long
Dim Max As Long
Dim NumRow As String
Dim Datas As String
'************************************
Dim NoDupes As New Collection
'************************************
Range("U65536").Select
On Error Resume Next
Cells.Find(sWord).Activate
If Not (Err.Number = 91) Then
ReDim Preserve FindWord(i)
NumRow = Space(8) & "LIGNE : " & Str$(ActiveCell.Row)
Set rStartCell = ActiveCell
For z = 1 To LastColumn(ActiveCell.Row)
Datas = Datas & sSeparator & CStr(Cells(ActiveCell.Row,
z).Text)
Next z
FindWord(i) = NumRow & sSeparator & Datas &
sSeparator
i = i + 1
Do
Cells.Find(sWord, Cells(ActiveCell.Row + 1, 1)).Activate
If ActiveCell.Address = Range(rStartCell.Address).Address
Then Exit Do
NumRow = Space(8) & "LIGNE : " & Str$(ActiveCell.Row)
ReDim Preserve FindWord(i)
Max = LastColumn(ActiveCell.Row)
For z = 1 To Max
'*******************************************
NoDupes.Add Cells(ActiveCell.Row, z).Value, CStr(Cells(ActiveCell.Row,
z).Text)
If Err.Number = 457 Then Err.Clear: Exit For
'*******************************************
Datas = Datas & sSeparator & CStr(Cells(ActiveCell.Row,
z).Text)
Next z
FindWord(i) = NumRow & sSeparator & Datas &
sSeparator
i = i + 1
Loop
End If
FindWords = FindWord: Erase FindWord
'*************************
For i = NoDupes.Count To 1 Step -1
NoDupes.Remove (i)
Next i
Set NoDupes = Nothing
'*************************
End Function
~
<small>[code.aspx?ID=39466 Mortalino] ~
Colorisation automatique</small>
@++
<hr size="2" width="100%" />( Nouveau forum : Exclusivement Office & VBA
voici la fonction juste pour la feuille en cours :
Option Explicit
Public Function FindWords(ByVal sWord As String) As String()
Dim rStartCell As Range
Dim FindWord() As String
Dim i As Long: i = 0
Dim z As Long
Dim Max As Long
Dim NumRow As String
Dim Datas As String
'************************************
Dim NoDupes As New Collection
'************************************
Range("U65536").Select
On Error Resume Next
Cells.Find(sWord).Activate
If Not (Err.Number = 91) Then
ReDim Preserve FindWord(i)
NumRow = Space(8) & "LIGNE : " & Str$(ActiveCell.Row)
Set rStartCell = ActiveCell
For z = 1 To LastColumn(ActiveCell.Row)
Datas = Datas & sSeparator & CStr(Cells(ActiveCell.Row,
z).Text)
Next z
FindWord(i) = NumRow & sSeparator & Datas &
sSeparator
i = i + 1
Do
Cells.Find(sWord, Cells(ActiveCell.Row + 1, 1)).Activate
If ActiveCell.Address = Range(rStartCell.Address).Address
Then Exit Do
NumRow = Space(8) & "LIGNE : " & Str$(ActiveCell.Row)
ReDim Preserve FindWord(i)
Max = LastColumn(ActiveCell.Row)
For z = 1 To Max
'*******************************************
NoDupes.Add Cells(ActiveCell.Row, z).Value, CStr(Cells(ActiveCell.Row,
z).Text)
If Err.Number = 457 Then Err.Clear: Exit For
'*******************************************
Datas = Datas & sSeparator & CStr(Cells(ActiveCell.Row,
z).Text)
Next z
FindWord(i) = NumRow & sSeparator & Datas &
sSeparator
i = i + 1
Loop
End If
FindWords = FindWord: Erase FindWord
'*************************
For i = NoDupes.Count To 1 Step -1
NoDupes.Remove (i)
Next i
Set NoDupes = Nothing
'*************************
End Function
~
<small>[code.aspx?ID=39466 Mortalino] ~
Colorisation automatique</small>
@++
<hr size="2" width="100%" />( Nouveau forum : Exclusivement Office & VBA
Vous n’avez pas trouvé la réponse que vous recherchez ?
Posez votre question
avyrex1926
Messages postés
360
Date d'inscription
dimanche 3 décembre 2006
Statut
Membre
Dernière intervention
3 janvier 2012
3
28 juil. 2007 à 00:26
28 juil. 2007 à 00:26
Merci encore pour ton aide
avyrex1926
Messages postés
360
Date d'inscription
dimanche 3 décembre 2006
Statut
Membre
Dernière intervention
3 janvier 2012
3
28 juil. 2007 à 01:24
28 juil. 2007 à 01:24
Petite question encore,
Il semble que les info se répete plusieurs fois dans la liste quand je fait la recherche au lieu de l'ecrire qu'une seul fois.
Ex:
Ligne 60
PB
5656
Alain
Rona
Pinceau
2$
Ligne 90
PB
5656
Alain
Rona
Pinceau
2$
PB
5678
Sylvain
Rona
Tableau
54$
Pourquoi la recherche double les résultat?
Il semble que les info se répete plusieurs fois dans la liste quand je fait la recherche au lieu de l'ecrire qu'une seul fois.
Ex:
Ligne 60
PB
5656
Alain
Rona
Pinceau
2$
Ligne 90
PB
5656
Alain
Rona
Pinceau
2$
PB
5678
Sylvain
Rona
Tableau
54$
Pourquoi la recherche double les résultat?
mortalino
Messages postés
6786
Date d'inscription
vendredi 16 décembre 2005
Statut
Membre
Dernière intervention
21 décembre 2011
18
28 juil. 2007 à 01:30
28 juil. 2007 à 01:30
heu ? Qu'y a-t-il en double ?
Ligne 90, ce qui est en gras et en dessous sont différents
@++
<hr size="2" width="100%" />( Nouveau forum : Exclusivement Office & VBA
Ligne 90, ce qui est en gras et en dessous sont différents
@++
<hr size="2" width="100%" />( Nouveau forum : Exclusivement Office & VBA
avyrex1926
Messages postés
360
Date d'inscription
dimanche 3 décembre 2006
Statut
Membre
Dernière intervention
3 janvier 2012
3
28 juil. 2007 à 01:38
28 juil. 2007 à 01:38
Ligne 90 = la ligne 60 + la ligne 90
Je comprend pas pourquoi
Je comprend pas pourquoi
mortalino
Messages postés
6786
Date d'inscription
vendredi 16 décembre 2005
Statut
Membre
Dernière intervention
21 décembre 2011
18
28 juil. 2007 à 01:42
28 juil. 2007 à 01:42
j'ai du mal a me représenter..
Quel est le mot mis en paramètre de recherche pour ce cas ?
Comment sont positionnées exactement ces données dans tes cellules ?
@++
<hr size="2" width="100%" />( Nouveau forum : Exclusivement Office & VBA
Quel est le mot mis en paramètre de recherche pour ce cas ?
Comment sont positionnées exactement ces données dans tes cellules ?
@++
<hr size="2" width="100%" />( Nouveau forum : Exclusivement Office & VBA
mortalino
Messages postés
6786
Date d'inscription
vendredi 16 décembre 2005
Statut
Membre
Dernière intervention
21 décembre 2011
18
28 juil. 2007 à 01:45
28 juil. 2007 à 01:45
vérifie ta ligne 90, qu'il n'y ait pas de données cachées ou dans les colonnes plus à droite
@++
<hr size="2" width="100%" />( Nouveau forum : Exclusivement Office & VBA
@++
<hr size="2" width="100%" />( Nouveau forum : Exclusivement Office & VBA
avyrex1926
Messages postés
360
Date d'inscription
dimanche 3 décembre 2006
Statut
Membre
Dernière intervention
3 janvier 2012
3
28 juil. 2007 à 01:49
28 juil. 2007 à 01:49
le mots en recherche est: Rona
et se qui sort comme recherche est:
Ligne 60
PB
5656
Alain
Rona
Pinceau
2$
Ligne 90
PB
5656
Alain
Rona
Pinceau
2$
PB
5678
Sylvain
Rona
Tableau
54$
et pourtant, il n'y à rien de caché dans ses ligne
et se qui sort comme recherche est:
Ligne 60
PB
5656
Alain
Rona
Pinceau
2$
Ligne 90
PB
5656
Alain
Rona
Pinceau
2$
PB
5678
Sylvain
Rona
Tableau
54$
et pourtant, il n'y à rien de caché dans ses ligne
mortalino
Messages postés
6786
Date d'inscription
vendredi 16 décembre 2005
Statut
Membre
Dernière intervention
21 décembre 2011
18
28 juil. 2007 à 02:00
28 juil. 2007 à 02:00
uoi, tu as raison, je regarde ça !
@++
<hr size="2" width="100%" />( Nouveau forum : Exclusivement Office & VBA
@++
<hr size="2" width="100%" />( Nouveau forum : Exclusivement Office & VBA
avyrex1926
Messages postés
360
Date d'inscription
dimanche 3 décembre 2006
Statut
Membre
Dernière intervention
3 janvier 2012
3
28 juil. 2007 à 02:01
28 juil. 2007 à 02:01
Je crois qu'a la première celule vide, il coupe les info.
Comment faire pour qu'il me donne les info par défaut de la colone A à Z de chaque ligne dond le mots recherché se trouve sur la ligne
Comment faire pour qu'il me donne les info par défaut de la colone A à Z de chaque ligne dond le mots recherché se trouve sur la ligne
mortalino
Messages postés
6786
Date d'inscription
vendredi 16 décembre 2005
Statut
Membre
Dernière intervention
21 décembre 2011
18
28 juil. 2007 à 02:18
28 juil. 2007 à 02:18
Trouvé, manquait une phrase (en commentaire), j'en ai profité pour une chose, supprime la fonction LastColumn, plus besoin. J'ai aussi supprimé la variable Max :
Option Explicit
Public Function FindWords(ByVal sWord As String) As String()
Dim rStartCell As Range
Dim FindWord() As String
Dim i As Long: i = 0
Dim z As Long
Dim NumRow As String
Dim Datas As String
Dim sSeparator As String: sSeparator = vbCrLf
'************************************
Dim NoDupes As New Collection
'************************************
Range("U65536").Select
On Error Resume Next
Cells.Find(sWord).Activate
If Not (Err.Number = 91) Then
ReDim Preserve FindWord(i)
NumRow = Space(8) & "LIGNE : " & Str$(ActiveCell.Row)
Set rStartCell = ActiveCell
For z = 1 To ActiveCell.End(xlToRight).Column
Datas = Datas & sSeparator & CStr(Cells(ActiveCell.Row,
z).Text)
Next z
FindWord(i) = NumRow & sSeparator & Datas &
sSeparator
i = i + 1
Do
Cells.Find(sWord, Cells(ActiveCell.Row + 1, 1)).Activate
If ActiveCell.Address = Range(rStartCell.Address).Address
Then Exit Do
Datas = vbNullString ' MANQUAIT CA ICI
###############################
NumRow = Space(8) & "LIGNE : " & Str$(ActiveCell.Row)
ReDim Preserve FindWord(i)
For z = 1 To ActiveCell.End(xlToRight).Column
'*******************************************
NoDupes.Add Cells(ActiveCell.Row, z).Value, CStr(Cells(ActiveCell.Row,
z).Text)
If Err.Number = 457 Then Err.Clear: Exit For
'*******************************************
Datas = Datas & sSeparator & CStr(Cells(ActiveCell.Row,
z).Text)
Next z
FindWord(i) = NumRow & sSeparator & Datas &
sSeparator
i = i + 1
Loop
End If
FindWords = FindWord: Erase FindWord
'*************************
For i = NoDupes.Count To 1 Step -1
NoDupes.Remove (i)
Next i
Set NoDupes = Nothing
'*************************
End Function
Sub test()
Dim aa() As String, i As Long
aa() = FindWords("Rona")
For i = LBound(aa) To UBound(aa)
Debug.Print aa(i)
Next i
End Sub
~
<small>[code.aspx?ID=39466 Mortalino] ~
Colorisation automatique</small>
@++
<hr size="2" width="100%" />( Nouveau forum : Exclusivement Office & VBA
Option Explicit
Public Function FindWords(ByVal sWord As String) As String()
Dim rStartCell As Range
Dim FindWord() As String
Dim i As Long: i = 0
Dim z As Long
Dim NumRow As String
Dim Datas As String
Dim sSeparator As String: sSeparator = vbCrLf
'************************************
Dim NoDupes As New Collection
'************************************
Range("U65536").Select
On Error Resume Next
Cells.Find(sWord).Activate
If Not (Err.Number = 91) Then
ReDim Preserve FindWord(i)
NumRow = Space(8) & "LIGNE : " & Str$(ActiveCell.Row)
Set rStartCell = ActiveCell
For z = 1 To ActiveCell.End(xlToRight).Column
Datas = Datas & sSeparator & CStr(Cells(ActiveCell.Row,
z).Text)
Next z
FindWord(i) = NumRow & sSeparator & Datas &
sSeparator
i = i + 1
Do
Cells.Find(sWord, Cells(ActiveCell.Row + 1, 1)).Activate
If ActiveCell.Address = Range(rStartCell.Address).Address
Then Exit Do
Datas = vbNullString ' MANQUAIT CA ICI
###############################
NumRow = Space(8) & "LIGNE : " & Str$(ActiveCell.Row)
ReDim Preserve FindWord(i)
For z = 1 To ActiveCell.End(xlToRight).Column
'*******************************************
NoDupes.Add Cells(ActiveCell.Row, z).Value, CStr(Cells(ActiveCell.Row,
z).Text)
If Err.Number = 457 Then Err.Clear: Exit For
'*******************************************
Datas = Datas & sSeparator & CStr(Cells(ActiveCell.Row,
z).Text)
Next z
FindWord(i) = NumRow & sSeparator & Datas &
sSeparator
i = i + 1
Loop
End If
FindWords = FindWord: Erase FindWord
'*************************
For i = NoDupes.Count To 1 Step -1
NoDupes.Remove (i)
Next i
Set NoDupes = Nothing
'*************************
End Function
Sub test()
Dim aa() As String, i As Long
aa() = FindWords("Rona")
For i = LBound(aa) To UBound(aa)
Debug.Print aa(i)
Next i
End Sub
~
<small>[code.aspx?ID=39466 Mortalino] ~
Colorisation automatique</small>
@++
<hr size="2" width="100%" />( Nouveau forum : Exclusivement Office & VBA
avyrex1926
Messages postés
360
Date d'inscription
dimanche 3 décembre 2006
Statut
Membre
Dernière intervention
3 janvier 2012
3
28 juil. 2007 à 02:34
28 juil. 2007 à 02:34
oups,
maintenant il me donne plein de ligne un en dessous de l'autre avec le signe de TAB
ex:
Ligne 60¶PB¶5656¶123456¶Rona¶
Ligne 68¶PB¶5662¶
Ligne 82¶
Ligne 99¶
Ligne 103¶
Ligne104¶
Ligne 126¶
Ligne 139¶
Ligne 175¶
maintenant il me donne plein de ligne un en dessous de l'autre avec le signe de TAB
ex:
Ligne 60¶PB¶5656¶123456¶Rona¶
Ligne 68¶PB¶5662¶
Ligne 82¶
Ligne 99¶
Ligne 103¶
Ligne104¶
Ligne 126¶
Ligne 139¶
Ligne 175¶
mortalino
Messages postés
6786
Date d'inscription
vendredi 16 décembre 2005
Statut
Membre
Dernière intervention
21 décembre 2011
18
28 juil. 2007 à 02:38
28 juil. 2007 à 02:38
normal, j'ai mis :
Dim sSeparator As String: sSeparator = vbCrLf
utilise celui que t'avais avant (donc supprime cette ligne dans ma fonction)
@++
<hr size="2" width="100%" />( Nouveau forum : Exclusivement Office & VBA
Dim sSeparator As String: sSeparator = vbCrLf
utilise celui que t'avais avant (donc supprime cette ligne dans ma fonction)
@++
<hr size="2" width="100%" />( Nouveau forum : Exclusivement Office & VBA
avyrex1926
Messages postés
360
Date d'inscription
dimanche 3 décembre 2006
Statut
Membre
Dernière intervention
3 janvier 2012
3
28 juil. 2007 à 02:46
28 juil. 2007 à 02:46
oui mais si par exemple:
ex:
Ligne 60¶PB¶5656¶123456¶Rona¶
Ligne 68¶PB¶5662¶
Ligne 82¶
Ligne 99¶
Ligne 103¶
Ligne104¶
Ligne 126¶
Ligne 139¶
Ligne 175¶
Dans la base de donnée, ok pour la ligne 60 avec les bonne infos.
La ligne 68 il manque la suite des infos.
La ligne 82, pas d'info du tout.
Mais pourtant, dans la base de donnée, il y a pourtant des info de la colone A à U.
C'est ça que je comprend pas.
ex:
Ligne 60¶PB¶5656¶123456¶Rona¶
Ligne 68¶PB¶5662¶
Ligne 82¶
Ligne 99¶
Ligne 103¶
Ligne104¶
Ligne 126¶
Ligne 139¶
Ligne 175¶
Dans la base de donnée, ok pour la ligne 60 avec les bonne infos.
La ligne 68 il manque la suite des infos.
La ligne 82, pas d'info du tout.
Mais pourtant, dans la base de donnée, il y a pourtant des info de la colone A à U.
C'est ça que je comprend pas.
avyrex1926
Messages postés
360
Date d'inscription
dimanche 3 décembre 2006
Statut
Membre
Dernière intervention
3 janvier 2012
3
28 juil. 2007 à 03:08
28 juil. 2007 à 03:08
Je vais tenter d'expliquer en détail se que je voudrais faire.
Ma recherche se fais de la colone A à Z de chaques lignes. Si par exemple je recherche le Mots RONA dans la liste, mëme s'il y a une celule vide disons dans la colone E de la ligne disons 60, les infos pourais me sortir dans mon ListBox1 comme suis:
<hr size= "2" width="100%" /> Ligne 60
PB 'Colone A
4556 'Colone B
PB45561 'Colone C
29/03/2007 'Colone D
29/03/2007 'Colone E
54660 'Colone F
RONA REGIONAL LONGUEUIL 'Colone G
5646 'Colone H
18 'Colone I
Sébastien Gauthier 'Colone J
9 'Colone K
2 'Colone L
Rouleau 9" époxy 'Colone M
'Colone N
'Colone O
'Colone P
2 'Colone Q
'Colone R
'Colone S
Fermé 'Colone T etc...
Ligne 90
et ainsi de suite.....
Donc il me donnerais tout les infos de la ligne si se trouve le mots recherché.
<col style =\"width: 63pt;\" width=\"84\" /><col />----
29/03/2007
Ma recherche se fais de la colone A à Z de chaques lignes. Si par exemple je recherche le Mots RONA dans la liste, mëme s'il y a une celule vide disons dans la colone E de la ligne disons 60, les infos pourais me sortir dans mon ListBox1 comme suis:
<hr size= "2" width="100%" /> Ligne 60
PB 'Colone A
4556 'Colone B
PB45561 'Colone C
29/03/2007 'Colone D
29/03/2007 'Colone E
54660 'Colone F
RONA REGIONAL LONGUEUIL 'Colone G
5646 'Colone H
18 'Colone I
Sébastien Gauthier 'Colone J
9 'Colone K
2 'Colone L
Rouleau 9" époxy 'Colone M
'Colone N
'Colone O
'Colone P
2 'Colone Q
'Colone R
'Colone S
Fermé 'Colone T etc...
Ligne 90
et ainsi de suite.....
Donc il me donnerais tout les infos de la ligne si se trouve le mots recherché.
<col style =\"width: 63pt;\" width=\"84\" /><col />----
29/03/2007
mortalino
Messages postés
6786
Date d'inscription
vendredi 16 décembre 2005
Statut
Membre
Dernière intervention
21 décembre 2011
18
28 juil. 2007 à 03:14
28 juil. 2007 à 03:14
Tiens, j'ai vraiment codé la fonction comme un sauvage, et donc pour réparer, c'est chiant, j'aurai pu éviter la collection, c'était question de facilité. Bref, voici une énième modif :
(déplacé la méthode Add de la collection)
Option Explicit
Public Function FindWords(ByVal sWord As String) As String()
Dim rStartCell As Range
Dim FindWord() As String
Dim i As Long: i = 0
Dim z As Long
Dim NumRow As String
Dim Datas As String
Dim sSeparator As String: sSeparator = vbCrLf
'************************************
Dim NoDupes As New Collection
'************************************
Range("U65536").Select
On Error Resume Next
Cells.Find(sWord).Activate
If Not (Err.Number = 91) Then
ReDim Preserve FindWord(i)
NumRow = Space(8) & "LIGNE : " & Str$(ActiveCell.Row)
Set rStartCell = ActiveCell
For z = 1 To ActiveCell.End(xlToRight).Column
Datas = Datas & sSeparator & CStr(Cells(ActiveCell.Row,
z).Text)
Next z
FindWord(i) = NumRow & sSeparator & Datas &
sSeparator
i = i + 1
Do
Cells.Find(sWord, Cells(ActiveCell.Row + 1, 1)).Activate
If ActiveCell.Address = Range(rStartCell.Address).Address
Then Exit Do
Datas = vbNullString
NumRow = Space(8) & "LIGNE : " & Str$(ActiveCell.Row)
ReDim Preserve FindWord(i)
For z = 1 To ActiveCell.End(xlToRight).Column
Datas = Datas & sSeparator & CStr(Cells(ActiveCell.Row,
z).Text)
Next z
'*******************************************
NoDupes.Add Cells(ActiveCell.Row, z).Value, CStr(Cells(ActiveCell.Row,
z).Text)
If Err.Number = 457 Then Err.Clear
'*******************************************
FindWord(i) = NumRow & sSeparator & Datas &
sSeparator
i = i + 1
Loop
End If
FindWords = FindWord: Erase FindWord
'*************************
For i = NoDupes.Count To 1 Step -1
NoDupes.Remove (i)
Next i
Set NoDupes = Nothing
'*************************
End Function
~
<small>[code.aspx?ID=39466 Mortalino] ~
Colorisation automatique</small>
@++
<hr size="2" width="100%" />( Nouveau forum : Exclusivement Office & VBA
(déplacé la méthode Add de la collection)
Option Explicit
Public Function FindWords(ByVal sWord As String) As String()
Dim rStartCell As Range
Dim FindWord() As String
Dim i As Long: i = 0
Dim z As Long
Dim NumRow As String
Dim Datas As String
Dim sSeparator As String: sSeparator = vbCrLf
'************************************
Dim NoDupes As New Collection
'************************************
Range("U65536").Select
On Error Resume Next
Cells.Find(sWord).Activate
If Not (Err.Number = 91) Then
ReDim Preserve FindWord(i)
NumRow = Space(8) & "LIGNE : " & Str$(ActiveCell.Row)
Set rStartCell = ActiveCell
For z = 1 To ActiveCell.End(xlToRight).Column
Datas = Datas & sSeparator & CStr(Cells(ActiveCell.Row,
z).Text)
Next z
FindWord(i) = NumRow & sSeparator & Datas &
sSeparator
i = i + 1
Do
Cells.Find(sWord, Cells(ActiveCell.Row + 1, 1)).Activate
If ActiveCell.Address = Range(rStartCell.Address).Address
Then Exit Do
Datas = vbNullString
NumRow = Space(8) & "LIGNE : " & Str$(ActiveCell.Row)
ReDim Preserve FindWord(i)
For z = 1 To ActiveCell.End(xlToRight).Column
Datas = Datas & sSeparator & CStr(Cells(ActiveCell.Row,
z).Text)
Next z
'*******************************************
NoDupes.Add Cells(ActiveCell.Row, z).Value, CStr(Cells(ActiveCell.Row,
z).Text)
If Err.Number = 457 Then Err.Clear
'*******************************************
FindWord(i) = NumRow & sSeparator & Datas &
sSeparator
i = i + 1
Loop
End If
FindWords = FindWord: Erase FindWord
'*************************
For i = NoDupes.Count To 1 Step -1
NoDupes.Remove (i)
Next i
Set NoDupes = Nothing
'*************************
End Function
~
<small>[code.aspx?ID=39466 Mortalino] ~
Colorisation automatique</small>
@++
<hr size="2" width="100%" />( Nouveau forum : Exclusivement Office & VBA
avyrex1926
Messages postés
360
Date d'inscription
dimanche 3 décembre 2006
Statut
Membre
Dernière intervention
3 janvier 2012
3
28 juil. 2007 à 14:58
28 juil. 2007 à 14:58
Mortalino,
Si je veux avoir le résultat un en dessous de l'autre au lieux de un à coté de l'autres séparrer par un ¶, et apres , avec un espace entre les lignes pour bien visualiser la nouvelle ligne et ses données, y a-t-il beaucoup à changer dans le script?
exemple:
Ligne 60
PB 'Colone A
4556 'Colone B
PB45561 'Colone C
29/03/2007 'Colone D
29/03/2007 'Colone E
54660 'Colone F
RONA REGIONAL LONGUEUIL 'Colone G
5646 'Colone H
18 'Colone I
Sébastien Gauthier 'Colone J
9 'Colone K
2 'Colone L
Rouleau 9" époxy 'Colone M
'Colone N
'Colone O
'Colone P
2 'Colone Q
'Colone R
'Colone S
Fermé 'Colone T etc...
Ligne 90
PB 'Colone A
4566 'Colone B
PB45661 'Colone C
30/03/2007 'Colone D
30/03/2007 'Colone E
64852 'Colone F
RONA REGIONAL LONGUEUIL 'Colone G
5646 'Colone H
18 'Colone I
Sébastien Gauthier 'Colone J
8 'Colone K
7 'Colone L
Pinceau 'Colone M
'Colone N
'Colone O
'Colone P
9 'Colone Q
'Colone R
'Colone S
Fermé 'Colone T etc...
Si je veux avoir le résultat un en dessous de l'autre au lieux de un à coté de l'autres séparrer par un ¶, et apres , avec un espace entre les lignes pour bien visualiser la nouvelle ligne et ses données, y a-t-il beaucoup à changer dans le script?
exemple:
Ligne 60
PB 'Colone A
4556 'Colone B
PB45561 'Colone C
29/03/2007 'Colone D
29/03/2007 'Colone E
54660 'Colone F
RONA REGIONAL LONGUEUIL 'Colone G
5646 'Colone H
18 'Colone I
Sébastien Gauthier 'Colone J
9 'Colone K
2 'Colone L
Rouleau 9" époxy 'Colone M
'Colone N
'Colone O
'Colone P
2 'Colone Q
'Colone R
'Colone S
Fermé 'Colone T etc...
Ligne 90
PB 'Colone A
4566 'Colone B
PB45661 'Colone C
30/03/2007 'Colone D
30/03/2007 'Colone E
64852 'Colone F
RONA REGIONAL LONGUEUIL 'Colone G
5646 'Colone H
18 'Colone I
Sébastien Gauthier 'Colone J
8 'Colone K
7 'Colone L
Pinceau 'Colone M
'Colone N
'Colone O
'Colone P
9 'Colone Q
'Colone R
'Colone S
Fermé 'Colone T etc...
