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
      c'est un GET en web service qui me permet de recuperer cette chaine de caractere

      cordialement
      0
      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. f894009
        Bonjour a vous tous
        Question:
        Votre chaine de caracteres provient de quoi? un fichier ou...?

        Merci
        0
        2. 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
            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
            2. 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. amine69500 Auteur
              Bonjour et merci de ton aide

              je vais essai et l'adapter a mon cas

              merci

              cordialement
              0
              1. 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
              3. 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
                1. 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