[XL-2003] Trouver une chaine de caractère

[Bocage]

Bonjour Forum,

je reviens avec un besoin d'être plus précis dans ce sous programme ou l'on recherche la présence d'une chaine caractère dans colonne contenant des abréviations. Le problème est qu'il trouve toute les occurences et que je voudrais seulement ceux qui débutent par cette chaine de caractère.

exemple : recherche RA : trouve RA, ICRA, FRA .

Function NbOccurrences(ByVal strMot As String) As Integer

' strMot : Mot recherché

Dim i As Integer
Dim Xls As Worksheet
Set Xls = ThisWorkbook.Worksheets("Résultats")
Set c = Xls.Columns(6).Find(strMot, LookIn:=xlValues, lookat:=xlPart)

    If Not c Is Nothing Then
        firstAddress = c.Address
        fmInterfaceSec.ListView2.ListItems.Clear
        Do
         '   MsgBox (c.Address)
            With fmInterfaceSec.ListView2
                .ListItems.Add , , Xls.Cells(c.row, 6) ' abrev
                ...etc...
                End With
               Set c = ActiveSheet.Columns(6).FindNext(c)
            Loop While Not c Is Nothing And c.Address <> firstAddress
        End If
End Function

je crains de devoir les vérifier un à un...et je ne vois pas comment

Merci de votre aide

Bo

[mapeh]

Bonsoir,

Est-ce que les mots recherchés sont en premier, dans la cellule, ou peuvent être situés n'importe où dans celle-ci?

Et s'ils sont situés n'importe où, ont-ils un espace avant?

A te relire

[Bocage]

Bonsoir Mapeh, forum

la chaine de caractère recherchée se situe tjrs au début de l'abréviation.

Bo

[mapeh]

Re-,

essaie ainsi, à mettre dans un module standard...

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
 

[Bocage]

Bonjour Mapeh, Forum,

Merci pour le code, le tout a fonctionné avec quelques ajustements, et une plus longue période de temps à comprendre le tout..Fort la transposée.

le résultat d'une recherche de "CA" a donné tous les abrév qui débutent par CA mais aucun CA à l'intérieur d'une abrév. Ce qui un grand pas.

Je vais voir comment ajouter une condition pour raffiner encore.

Merci et A+

Bo

[Krovax]

Bonjour,
Une méthode pour trouver les chaine de caractère ou quelle soit (début, milieu ou fin")

 
Function NbOccurrences(ByVal strMot As String) As Integer
Dim i as long, DerniereLigne  as long
DerniereLigne = Worksheets("Résultats").Range("A65536").End(xlUp).Row 'donne la dernièreligne de la colonne A remplace le A par ta colonne
NbOccurrences=0
For i = 2 to DerniereLigne  'on parcour de la ddeuxième a la dernièreligne
If Worksheets("Résultats").cells(i,1) like "*" & strMot  & "*" then 'si il y a RA dans la cellule
    NbOccurrences=NbOccurrences+1
end if
next i  
end function

Tu peux aussi utilisé find qui sera plus rapide
Si la recher doit se faire dans le premier mot seulement de la cellule

If split(Worksheets("Résultats").cells(i,1)," ")(0) like "*" & strMot  & "*" then

[Bocage]

Bonjour Mapeh, Krovax, forum,

Tout fonctionne super bien. Merci encore...

Bo