1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37
| Public Recherches As Object
Sub Cherche()
NbOccurrences "RA"
If Recherches.Count = 0 Then Exit Sub
With Sheets("Résultats")
temp = Application.Transpose(Recherches.Items)
fmInterfaceSec.ListView2.ListItems.Clear
If Recherches.Count = 1 Then
fmInterfaceSec.ListView2.ListItems.Add , , .Cells(temp(x), 6).Value ' abrev
Else
For x = LBound(temp) To UBound(temp) - 1
fmInterfaceSec.ListView2.ListItems.Add , , .Cells(temp(x, 1), 6).Value ' abrev
Next x
End If
End With
End Sub
Function NbOccurrences(ByVal strMot As String) As Integer
Dim Lig As Long, Derlig As Long, Lig2 As Long
Dim Xls As Worksheet
Set Recherches = CreateObject("Scripting.Dictionary")
Set Xls = ThisWorkbook.Worksheets("Résultats")
On Error Resume Next
With Xls
Derlig = .[F65000].End(xlUp).Row
Lig = Application.Match(strMot & "*", .Columns(6), 0)
If IsError(Lig) Then Exit Function
Recherches.Item(Lig) = Lig
While Err.Number = 0
Lig2 = Application.Match(strMot & "*", .Range(.Cells(Lig + 1, 6), .Cells(Derlig + 1, 6)), 0)
Recherches.Item(Lig2 + Lig) = Lig2 + Lig
Lig = Lig2 + Lig
Wend
End With
End Function |
Partager