Excel vba recherche

Résolu
amine69500 -  
Bonjour,

voila j'ai une chaine de caractere et je souhaiterais créer une fonction qui me permet de recuperer quelques données

voila ma chaine de caractere

[test,"id":"12345","name":"données1","lead","name":"xxxx",test,"id":"12345","name":"données2","lead","name":"yyyy",test,"id":"12345","name":"données3","lead","name":"zzzzz"]

mon but est de recuperer ce qu'il se trouve entre lead et name donc donnée1,données2,donnée3.

et construire un tableau dans lequel je trouve :
donnée1
donnée2
donnée3

merci de votre aide

Cordialement

13 réponses

  1.  Mytå Contributeur
    Salut le forum

    A tester 
    Option Explicit

Sub Extraire()
Dim i As Byte, Lig As Byte
Dim Chaine As Variant

    Chaine = Split(Replace([A1], """", ""), "name:")
    Lig = 2
    For i = 0 To UBound(Chaine)
        If InStr(Chaine(i), "lead") Then
            Cells(Lig, 1) = Split(Chaine(i), ",")(0)
            Lig = Lig + 1
        End If
    Next i
    
End Sub

    Mytå
    3
    1. amine69500 Auteur
      Trop trop fort ou forte ca marche super meme sur ma chaine de caractere direct sans rien changer au code, trop trop fort ou forte

      merci mille fois a tous ce qui m'ont aidé

      merci encore

      Cordialement

      Myta, tu peut m'expliquer un peu ton code? STP merci
      1
      1. Mytå Contributeur
        Re le forum 

        Sub Extraire()
Dim i As Byte, Lig As Byte
Dim Chaine As Variant

    Chaine = Split(Replace([A1], """", ""), "name:")
    Lig = 2
    
    If UBound(Chaine) = -1 Then Exit Sub
    
    For i = 0 To UBound(Chaine)
        If InStr(Chaine(i), "lead") Then
            Cells(Lig, 1) = Split(Chaine(i), ",")(0)
            Lig = Lig + 1
        End If
    Next i

End Sub

        Suppression des guillemets et découpage de la Chaine avec l'expression name: 
        Chaine = Split(Replace([A1], """", ""), "name:")

        Si le Tableau (Chaine) est vide on quitte la procédure 
        If UBound(Chaine) = -1 Then Exit Sub

        On boucle sur le Tableau (Chaine) à la recherche de l'expression lead
        Si l'expression est trouvé on écrit le premier élément du découpage avec la virgule 
            For i = 0 To UBound(Chaine)
        If InStr(Chaine(i), "lead") Then
            Cells(Lig, 1) = Split(Chaine(i), ",")(0)
            Lig = Lig + 1
        End If
    Next i

        Mytå
        0
      2. amine69500 Auteur
        Bonjour Myta,

        Je souhaterais utilisé ta fonction mais au lieu d'avoir le resultat dans les cellules je souhaite les avoir dans une listbox ou combobox qui sont dans un userform

        est-il possible et si oui

        tu peu m'aider STP

        Merci

        Cordialement
        0
      3. Mytå Contributeur
        Re le forum

        Modifie le code comme ceci 
        ' . . .
For i = 0 To UBound(Chaine)
        If InStr(Chaine(i), "lead") Then
            UserfForm1.ListBox1.AddItem Split(Chaine(i), ",")(0)
        End If
    Next i
' . . .

        Mytå
        0
    2. Morgothal
      Salut,
      C'est pas exactement le même souci que dans ce sujet ?
      La même solution fonctionne avec le même problème...
      0
      1. amine69500 Auteur
        Bonjour et merci de votre aide
        non c'est pas excatement ca, ce que je cherche la, c'est un code qui me permet d'extraire une chaine de caratere entre deux chaine de caractere, ici c'est donnée1 qui est entre lead et name.

        merci de votre aide

        Cordialement
        0
        3. f894009
          Bonjour,

          Un exemple en VBA (donnees1, etc ne sont peut-etre pas de longueurs fixes) 

          Sub rechchaine()
  '123456789012345678901234567890123456789
  '[test,"id":"12345","name":"données1","lead","name":"xxxx",test,"id":"12345","name":"données2","lead","name":"yyyy",test,"id":"12345","name":"données3","lead","name":"zzzzz"]


  Entete = "5" & Chr(34) & "," & Chr(34) & "name"
  Suffix = "lead"
  chaine = Worksheets("feuil2").Range("A1")
  
  y = InStr(1, chaine, Entete) + 11
  x = InStr(1, chaine, Suffix) - 3
  D1 = Mid(chaine, y, x - y)
  
  y = InStr(x + 6, chaine, Entete) + 11
  a = InStr(x + 6, chaine, Suffix) - 3
  D2 = Mid(chaine, y, a - y)

  y = InStr(a + 6, chaine, Entete) + 11
  b = InStr(a + 6, chaine, Suffix) - 3
  D3 = Mid(chaine, y, b - y)
  
End Sub


          L'exemple de Morgothal peut etre modifie de meme, si le coeur lui en dit

          Bonne suite
          0
          1. Morgothal
            Salut,
            Le coeur m'en dit volontiers, je suis en train de voir ;)
            Cependant, dans ton code il faut que l'ID finisse toujours par "5" ?
            0
          2. f894009
            Re,
            Eh Oui, des fois l'arbre cache la foret.......!!
            Merci
            0
        4. amine69500 Auteur
          Bonjour et merci de ton aide

          je vais essai et l'adapter a mon cas

          merci

          cordialement
          0
          1. Morgothal
            Cette macro fonctionne également : 

            Sub recherchedechaine()
Dim colonne As Integer
Dim D1, tabl(3) As String

    Range("A1").Select
    Selection.TextToColumns Destination:=Range("A1"), DataType:=xlDelimited, _
        TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
        Semicolon:=False, Comma:=True, Space:=False, Other:=False, FieldInfo _
        :=Array(Array(1, 1), Array(2, 1), Array(3, 1), Array(4, 1), Array(5, 1), Array(6, 1), _
        Array(7, 1), Array(8, 1), Array(9, 1), Array(10, 1), Array(11, 1), Array(12, 1), Array(13, 1 _
        ), Array(14, 1), Array(15, 1)), TrailingMinusNumbers:=True

        
D1 = ""
i = 1
For colonne = 1 To 15
    If Left(Cells(1, colonne), 4) = "name" And Cells(1, colonne + 1) = "lead" Then
        tabl(i) = Mid(Cells(1, colonne).Value, 7, Len(Cells(1, colonne).Value) - 7)
        i = i + 1
    End If
Next

For i = 1 To 3
Cells(i + 2, 1) = tabl(i)
Next

End Sub

            0
            1. amine69500 Auteur
              Salut et merci de ton aide

              j'ai essayé ta solution, mais il met l'erreur "le texte est trop long" es normale?

              Cordialement
              0
            2. Morgothal
              Aha "est-ce qu'une erreur est normale"
              Bonne question de réthorique ;)

              Mais en l'occurrence non ce n'est pas normal... En exécutant le programme pas à pas avec F8, où est l'erreur? Pour ma par je n'ai pas cette erreur...

              Dans l'attente de te lire,
              0
            3. amine69500 Auteur
              pouvez vous m'expliquer un peu votre code SVP, j'ai voulu le testé avec ma chaine de caractere car celle donnée avec la question est juste un exemple. et ca ne marche pas

              je souhaiterai comprendre un peu plus votre code pour l'appliquer a ma chaine de caractere.

              merci de votre aide

              Cordialement
              0
            4. Morgothal
              Toute la première partie (avant le D1="") sert a mettre chaque partie de la chaîne de caractères entre "," dans plusieurs cellules.
              La seconde partie détermine si le contenu d'une cellule se trouve entre "name" et "lead", et si oui le met dans le tableau tabl(i).
              0
            5. amine69500 Auteur
              Ok super merci pour cette explication

              Cordialement
              0
          3. f894009
            Re,

            Code modifie, en effet "12345" doit etre un nombre sur 5 caracteres. 

            Sub rechchaine()
  '123456789012345678901234567890123456789
  '[test,"id":"12345","name":"données1","lead","name":"xxxx",test,"id":"12345","name":"données2","lead","name":"yyyy",test,"id":"12345","name":"données3","lead","name":"zzzzz"]

  test = "test"
  Entete = "name"
  Suffix = "lead"
  
  'Chaine en Feuil2 A1 pour exemple
  chaine = Worksheets("feuil2").Range("A1")
  'recherche pour D1
  y = InStr(1, chaine, Entete) + 7
  x = InStr(1, chaine, Suffix) - 3
  D1 = Mid(chaine, y, x - y)
  'recherche test poour D2
  a = InStr(x, chaine, test)
  y = InStr(a, chaine, Entete) + 7
  x = InStr(a, chaine, Suffix) - 3
  D2 = Mid(chaine, y, x - y)
  'recherche test poour D3
  a = InStr(x, chaine, test)
  y = InStr(a, chaine, Entete) + 7
  x = InStr(a, chaine, Suffix) - 3
  D3 = Mid(chaine, y, x - y)
  
End Sub
            0
            1. amine69500 Auteur
              Super merci a tous,

              j'ai essayé vos solutions ca marche super mais avec une chaine de caractere fixe alors ma chaine de caractere peut varier exemple : aujourdhui elle la 3000 caractere demain elle aura 3500 caractere et ainsi de suite.

              merci de m'aider si vous pouvez

              merci encore de votre aide

              Cordialement
              0
              1. f894009
                Bonjour a vous tous
                Question:
                Votre chaine de caracteres provient de quoi? un fichier ou...?

                Merci
                0
                1. amine69500 Auteur
                  c'est un GET en web service qui me permet de recuperer cette chaine de caractere

                  cordialement
                  0