macro de recherche

[RICO]

Bonjour,
je m'adresse à tous ceux qui peuvent m'aider, je vous remercie d'avance pour vos réponses (vous me retirerez une belle épine du pieds le cas échéant);

Dans un Userform, je désire y placer un Textbox (de saisie), un bouton Commande (pour lancer une recherche et un Listbox (pour y voir tous les résultats) :
textbox1 = mot ou chiffre permettant une recherche dans une feuille EXCEL « Fichier » (très long = 150 colonnes et 6000 lignes) dans une plage de colonnes allant de A à G

Listbox1 (avec 4 ou 5 colonnes et 15 à 20 lignes) ; (Bcp de mots peuvent se ressembler ou même être identiques mais ne sont pas de la même fiche).

Voici mon essai, mais il ne fonctionne pas :
Private Sub CommandButton4_Click() = bouton de « Recherche »
'Recherche multicritère du Fichier
Dim i As Integer
Dim TexteRecherche As String
Dim R As Range
Dim Add1 As String
Dim Tableau(10, 1) As String
i = 1
Sheets("Fichier").Select
With Worksheets("Fichier")
TexteRecherche = Me.TextBox1
Set R = .Range("A:G").Find(TexteRecherche)
Add1 = R.Address
Tableau(0, 0) = Right(R.Address, 4)
Tableau(0, 1) = R
Set R = .Range("A:G").FindNext(R)
Do Until R.Address = Add1
'Affectation tableau
Tableau(i, 1) = R
'Récupération du numéro de ligne
Tableau(i, 0) = Right(R.Address, 4)
i = i + 1
Set R = .Range("A:G").FindNext(R)
Loop
ListBox1.List() = Tableau
End With
End Sub


Le but final étant de cliquer sur l’un des résultat de la Listbox et de copier à un autre endroit de la feuille « Fichier » (par exemple en ligne 2 (à partir de A2) de cette même feuille.

Voici mon essai qui ne fonctionne pas :
Private Sub ListBox1_Click()
'recopie la sélection de la listbox en A2
Range("a2") = Me.ListBox1.Column(1)
Range("A" & Me.ListBox1 & "D" & Me.ListBox1).Copy Range("A2")
Unload Me

 

[Ronan]

Bonsoir,

Un exemple qui cherche une valeur saisie d'un textbox dans un fichier texte

(Proc à adapter pour un tableau dans Excel)

Private Sub CommandButton3_Click()
If TextBox1.Value = Empty Then Exit Sub
RechercheLigneSuiviCtrlPreEntree "c:\SuiviCtrlPreEntree.sqm"
End Sub


Public Sub RechercheLigneSuiviCtrlPreEntree(FichierSource)
ref = UCase(SuiviCtrlPreEntree.TextBox1.Value)
f1 = FreeFile
ligne = 0
trouve = 0
Open (FichierSource) For Input As #f1
While Not EOF(f1)
Input #f1, valu1, valu2, valu3, valu4
If ref = valu1 Then trouve = 1: GoTo fin
ligne = ligne + 1
Wend
fin:
Close #f1
If trouve = 1 Then
ligne = ligne - 1
SuiviCtrlPreEntree.ListBox1.ListIndex = (ligne)
SuiviCtrlPreEntree.ListBox1.Selected(ligne) = True
End If
SuiviCtrlPreEntree.TextBox1.Value = Empty
SuiviCtrlPreEntree.TextBox1.SetFocus
End Sub

Puis, inscrire la ligne sélectionnée de la listbox dans un autre fichier et l'extraire du précédent fichier :

Private Sub CommandButton1_Click()

trouve = 0

With SuiviCtrlPreEntree

TotalLigne = .ListBox1.ListCount - 1

For boucle = 0 To TotalLigne
If .ListBox1.Selected(boucle) = True Then trouve = 1: Exit For
Next boucle
If trouve = 0 Then
MsgBox "Veuillez sélectionner une ligne", vbOKOnly, "Erreur procédure"
Exit Sub
End If

Valide1SuiviCtrlPreEntree

.TextBox1.SetFocus

End With

End Sub

Public Sub Valide1SuiviCtrlPreEntree()
debut:
With SuiviCtrlPreEntree
TotalLigne = .ListBox1.ListCount - 1
For boucle = 0 To TotalLigne
If .ListBox1.Selected(boucle) Then
LigneFichier = boucle + 1
f1 = FreeFile
Open ("c:\SuiviCtrlPreEntree.sqm") For Input As #f1
LigneLue = 0
While Not EOF(f1)
Input #f1, valu1, valu2, valu3, valu4
If LigneFichier = LigneLue Then
f3 = FreeFile
Open ("c:\ArchiveSuiviCtrlPreEntree.sqm") For Append As #f3
Write #f3, valu1, valu2, valu3, valu4
Close #f3
Else
f2 = FreeFile
Open ("c:\SuiviCtrlPreEntree.tmp") For Append As #f2
Write #f2, valu1, valu2, valu3, valu4
Close #f2
End If
LigneLue = LigneLue + 1
Wend
Close #f1
.ListBox1.RemoveItem (boucle)
Kill ("c:\SuiviCtrlPreEntree.sqm")
Name ("c:\SuiviCtrlPreEntree.tmp")As("c:\SuiviCtrlPreEntree.sqm")
GoTo debut
End If
Next boucle
End With
End Sub


Simple pour moi ... mais pour vous ???

@+

Ronan