Function FindAll(ByVal sText As String, ByRef oSht As Worksheet, ByRef sRange As String, ByRef arMatches() As String) As Boolean ' -------------------------------------------------------------------------------------------------------------- ' FindAll - To find all instances of the1 given string and return the row numbers. ' If there are not any matches the function will return false ' -------------------------------------------------------------------------------------------------------------- On Error GoTo Err_Trap Dim rFnd As Range ' Range Object Dim iArr As Integer ' Counter for Array Dim rFirstAddress ' Address of the First Find ' ----------------- ' Clear the Array ' ----------------- Erase arMatches Set rFnd = oSht.Range(sRange).Find(what:=sText, LookIn:=xlValues, lookAt:=xlPart) If Not rFnd Is Nothing Then rFirstAddress = rFnd.Address Do Until rFnd Is Nothing iArr = iArr + 1 ReDim Preserve arMatches(iArr) arMatches(iArr) = rFnd.Row 'rFnd.Address pour adresse complete ' rFnd.Row Pour N° de ligne Set rFnd = oSht.Range(sRange).FindNext(rFnd) If rFnd.Address = rFirstAddress Then Exit Do ' Do not allow wrapped search Loop FindAll = True Else ' ---------------------- ' No Value is Found ' ---------------------- FindAll = False End If ' ----------------------- ' Error Handling ' ----------------------- Err_Trap: If Err <> 0 Then MsgBox Err.Number & " " & Err.Description, vbInformation, "Find All" Err.Clear FindAll = False Exit Function End If End Function
Sub Exemple_util_Findall() Dim arTemp() As String 'variable tableau pour la fonction Findall Dim ValCherchee as string ValCherchee="test" Dim Nom_Feuil as string Nom_Feuil = "Feuil1" '--------------------------------------------------------------- bFound = FindAll(ValCherchee, Sheets(Nom_Feuil), ma_plage, arTemp()) '--------------------------------------------------------------- If bFound = True Then Debug.Print "Nb occurences : " & UBound(arTemp) For X = 1 To UBound(arTemp) debug.print "ligne : " & arTemp(X) Next End If End sub
If Not Cel Is Nothing Then ajout_liste ListBox1, .Range("A" & Cel.Row).Valueà compléter ainsi
If Not Cel Is Nothing Then ajout_liste ListBox1, .Range("A" & Cel.Row).Value Else Exit Do________________________
Private Sub CommandButtonRechercheVin_Click()Rien ne t'empêche de conserver, si tu y trouves un réel intérêt, ta feuille "Ma Cave", mais on évite ainsi de l'utiliser pour la recherche. Et du coup : et de l'activer et d'attendre qu'elle aussi termine son traitement.
Dim Cel As Range, Depart As String, ref As String, F As Worksheet
ref = Me.TextBox1.Text
With Me.ListBox1
.Clear: If ref = "" Then Exit Sub
.Visible = False
End With
ref = Me.TextBox1.Text
For Each F In Worksheets
If F.Name <> "Menu" And F.Name <> "Ma Cave" Then
With F
Set Cel = .Columns("I").Cells.Find(What:=ref, LookIn:=xlValues, lookat:=xlPart)
If Not Cel Is Nothing Then
ajout_liste ListBox1, .Range("A" & Cel.Row).Value
Depart = Cel.Address
Do
Set Cel = .Columns("I").Cells.FindNext(Cel)
If Not Cel Is Nothing Then ajout_liste ListBox1, .Range("A" & Cel.Row).Value Else Exit Do
Loop While Depart <> Cel.Address Or Cel Is Nothing
End If
End With
End If
Next
ListBox1.Visible = True
If ListBox1.ListCount = 0 Then
MsgBox "Pas trouvé de vin en accord avec " & ref & "", vbCritical
End If
End Sub
Private Sub ajout_liste(LB As Object, c As String)
LB.ListIndex = -1
On Error Resume Next
LB.Text = c
On Error GoTo 0
If LB.ListIndex = -1 Then LB.AddItem c
End Sub
Vous n’avez pas trouvé la réponse que vous recherchez ?
Posez votre questionPrivate Sub retour_Click()Pour quel bénéfice ? ===>> celui de l'utilisateur (c'est toujours à lui, qu'il convient de penser proritairement, pour toute application)
Dim ActAs As Worksheet, i As Integer, dl As Long
Set ActAs = ActiveSheet
Select Case UCase(ActAs.Name)
Case "VINS"
i = 2
Case "METS"
i = 4
Case Else
i = 0
End Select
If i > 0 Then
ActAs.Sort.SortFields.Clear
dl = ActAs.Range("A" & Rows.Count).End(xlUp).Row
ActAs.Sort.SortFields.Add Key:=Range( _
"A" & i & ":A" & dl), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
xlSortNormal
With ActAs.Sort
.SetRange ActAs.Range("A" & i & ":O" & dl)
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
End If
ListBox3.Visible = False
For i = 1 To 3
Me.Controls("Listbox" & i).RowSource = ""
Me.Controls("Listbox" & i).Clear
Next
retour.Visible = False
Me.Move 0, 0, ECRAN.largeur / 1.32, ECRAN.hauteur / 1.32
End Sub
21 janv. 2014 à 22:58
Je débranche donc mon autre PC.
Si tu es fatigué : repose-toi.