Rechercher un mot dans un tableau

Bonjour à tous,

J'aimerais trouver une sous-chaines dans un tableau de type variant.

Une fois trouvée, on devra récupérer tous les numéros correspondants.

J'ai essayé avec Application.Match et Application.Index, mais j'ai toujours une erreur 2042 :

p = Application.Match(mot, Application.Index(a, , 1), 0)

p = Application.Match(mot, a, 1)

Un exemple en PJ.

Merci d’avance.

Bonjour,

n = Evaluate("MATCH(""*""&H1&""*"",A:A,0)")

Bonjour sabV,

En appliquant la solution proposée, avec H1="sc1", n sera égal à erreur 2029 !

Sub rechercheTb()
Dim Mot As String

    a = [A2:A30]
    For i = LBound(a) To UBound(a)

        ' Si H1 = Tous récupérer tous les numéros
        ' Si H1 = une sous-chaine à rechercher alors
        ' Récupérer seulement les sous-chaines identiques
        ' avec leurs numéros correspondants

        Mot = [H1]
        n = Evaluate("MATCH(""*"" & Mot & ""*"",a,0)")
    Next

End Sub

Bonjour,

pour information la syntaxe avec une variable est:

n = Evaluate("MATCH(""*" & mot & "*"",A1:A30,0)")

mais je trouve cette méthode moins adapté à votre fichier.

je vous propose une autre alternative

Sub test1()
Dim mot As String, AL1, AL2
Dim i As Integer, Lastrw As Long, plg As Range, c As Range, cc As Range
Set AL1 = CreateObject("System.Collections.ArrayList")
Set AL2 = CreateObject("System.Collections.ArrayList")
mot = Sheets("Feuil1").Range("H1")
Lastrw = Sheets("Feuil1").Cells(Rows.Count, 1).End(xlUp).Row
Range("K2:L" & Lastrw).ClearContents

Set plg = Sheets("Feuil1").Range("A2:A" & Lastrw)
  For Each c In plg
    If Not IsError(Application.Find(mot, c)) Then AL1.Add c.Row
  Next
  r = AL1.Toarray()
  For i = LBound(r) To UBound(r)
  Addr = "A" & r(i) + 1
    For Each cc In Range(Addr & ":A" & Lastrw)
       If IsNumeric(cc) Then
         AL2.Add Range("A" & r(i)) & "-" & cc.Value
       Else
         GoTo nt:
       End If
    Next
nt:
  Next

With Range("K2")
.Resize(AL2.Count, 1) = Application.Transpose(AL2.Toarray())
.Resize(AL2.Count, 1).TextToColumns Destination:=Range(.Address), DataType:=xlDelimited, _
        TextQualifier:=xlDoubleQuote, Tab:=True, Other:=True, OtherChar:="-", FieldInfo:=Array(Array(1, 1), Array(2, 1)), TrailingMinusNumbers:=True
End With
End Sub

Bonsoir sabV,

Merci pour le code.

A noter que les données du tableau a sont récupérés depuis un fichier texte.

Le résultat de l'extraction depuis le tableau a, selon un mot recherché, sera écrit dans un fichier texte.

C'est pour ça que je n’utilise pas les plages dans mon code.

Bon, je vais essayer de tirer une idée du code.

Bonsoir,

J’aimerais traiter le cas ou mot = "tous".

Une idée ?

Sub RechercheTb()
    Dim mot    As String, rL1, rL2
    Dim i As Integer, Lastrw As Long, plg As Range, c As Range, cc As Range

    Set rL1 = CreateObject("System.Collections.ArrayList")
    Set rL2 = CreateObject("System.Collections.ArrayList")

    mot = Sheets("Feuil1").Range("H1")
    Lastrw = Sheets("Feuil1").Cells(Rows.Count, 1).End(xlUp).Row
    Range("K2:L" & Lastrw).ClearContents

    a = Sheets("Feuil1").Range("A2:A" & Lastrw)

    If mot <> "tous" Then
        For i = LBound(a) To UBound(a)
            If InStr(1, a(i, 1), mot) > 0 Then
                rL1.Add i    'c.Row
            End If
        Next
    End If

    r = rL1.Toarray()

    ' Si mot = "tous" alors ?
    ' If mot = "tous" Then
    ' ?
    ' Else
    For j = LBound(r) To UBound(r)
        For k = r(j) + 1 To UBound(a)
            If IsNumeric(Split(a(k, 1), "L3-")(1)) Then
                rL2.Add Mid(a(k, 1), 4, Len(a(k, 1)) - 3)
            Else
                GoTo nt:
            End If
        Next
nt:
    Next

End Sub

Merci.

Bonjour à tous,

Voila un code simplifié, ou j'ai besoin d'une solution en cas ou mot="Tous", ce qui veut dire le tableau r est vide :

Ubound(r)=-1  ' (pas d’éléments)

Sub RechercheTb()
    Dim B()
    Dim Mot    As String, rL1, rL2
    Set rL1 = CreateObject("System.Collections.ArrayList")
    Set rL1 = CreateObject("System.Collections.ArrayList")

    ReDim B(1 To 25)
    B(1) = "<! AA (TIT);"
    B(2) = "120121"
    B(3) = "120122"
    B(4) = "120121"
    B(5) = "<! AB (MJD);"
    B(6) = "147852"
    B(7) = "147853"
    B(8) = "147854"
    B(9) = "147855"
    B(10) = "<! BC (TIT);"
    B(11) = "898874"
    B(12) = "898875"
    B(13) = "898876"
    B(14) = "<! SD (FGD);"
    B(15) = "325698"
    B(16) = "325699"
    B(17) = "<! ZE (TIT);"
    B(18) = "111478"
    B(19) = "111479"
    B(20) = "111480"
    B(21) = "<! HC (MJD);"
    B(22) = "251448"
    B(23) = "251449"
    B(24) = "251450"

    Mot = Sheets("Feuil1").Range("T3")

    If Mot <> "tous" Then
        FcNm = "Clients " & Mot & ".txt"
    Else
        FcNm = "Clients global.txt"
    End If

    If Mot <> "tous" Then
        For i = LBound(B) To UBound(B)
            If InStr(1, B(i), Mot) > 0 Then
                rL1.Add i   
            End If
        Next
    End If

    r = rL1.Toarray()

    For j = LBound(r) To UBound(r)
Debug.Print "Agence en cours : " & B(r(j))
        ' Boucle sur le tableau (B) des données à traiter
        For Z = r(j) + 1 To UBound(B)
            ' Si c'est un numéro
            If IsNumeric((B(Z))) Then
Debug.Print B(Z)
                '                rL2.Add B(Z)
            Else ' C'est un nom d'agence
Debug.Print B(Z)
                GoTo nt:
            End If
        Next
nt:
    Next
End Sub