Extraire mot

Résolu
Saab16 -  
 saab.16 -
Bonjour,

Je souhaiterais savoir si il est possible d'extraire d'une cellule des mots pour les importer dans une autre colonne dans la limite de 50 caractères. Pour les 50 caractères suivants, de les importer dans une deuxième colonne et ainsi de suite ?
Il est peut-être possible de le faire à l'aide d'une boucle dans VBA ?

Quelqu'un pourrait m'aider ?

Merci d'avance.

6 réponses

  1. Mike-31 Messages postés 18405 Date d'inscription   Statut Contributeur Dernière intervention   5 147
     
    Bonsoir,

    Oui bien sur, mais il faut être plus précis
    - quel type de donnée se trouve dans les cellules
    - extraire un nombre de caractère à partir de quel critère
    - la partie à extraire est elle à gauche, au centre ou à droite
    - pourquoi en VBA, il est certainement possible par formule
    0
    1. Saab16
       
      Il s'agit d'un champ comportant la désignation d'un article :
      Exemple : ¨Biscuit au chocolat à l'arôme naturel de banane et vanille - Pack de 6.
      Ceci n'est qu'un exemple, il n'existe pas de format identique, certains ont des - d'autres non.
      Je souhaiterais extraire les 50 premiers caractères dans la colonne 1, les 50 suivants dans la colonne 2 ... Le problème est que je veux garder que des mots complets :

      Ok : Biscuit au chocolat
      Ko : Biscuit au chocol

      Suis-je un peu plus claire ?

      Merci beaucoup
      0
  2. nihcoc Messages postés 193 Date d'inscription   Statut Membre Dernière intervention   5
     
    Bonjour

    mettre l'exemple en A1

    en B1 = =GAUCHE(A1;50)
    en C1 = =STXT(A1;51;50)
    en D1 si besoin = =STXT(A1;101;50)
    et ainsi de suite.

    A+
    0
  3. cs_Le Pivert Messages postés 8437 Statut Contributeur 730
     
    Voici un exemple avec 20 caractères :

    Option Explicit
     Dim result As String
    Private Sub CommandButton1_Click()
    Extraction
    End Sub
    Sub Extraction()
    Dim cible, requete, chaine As String
    Dim i, x As Integer
    cible = "Recherche le premier espace après le 20ème caractère"
            requete = ""
    
            For i = 1 To Len(cible)
                'Recherche le premier espace après le 20ème caractère
                x = InStr(20, cible, " ")
                
                If x = 0 Then
                    chaine = cible
                    requete = requete & """" & chaine & """"
                    Exit For
                End If
                
                chaine = Mid(cible, 1, x)
                requete = requete & """" & chaine & """ & _" & vbCrLf
                cible = Mid(cible, Len(chaine) + 1)
              Next
        
        Debug.Print requete
         result = requete
      extractionMots
         
    End Sub
    Sub extractionMots()
        Dim Tableau() As String
        Dim i As Integer
        
        'découpe la chaine en fonction des "&"
        'le résultat de la fonction Split est stocké dans un tableau
        Tableau = Split(result, "&")
        
        'boucle sur le tableau pour visualiser le résultat
        For i = 0 To UBound(Tableau)
            'Le résultat s'affiche dans la fenêtre d'execution de l'éditeur de macros
            Debug.Print Tableau(i)
        Next i
        MsgBox Tableau(0)
        MsgBox Tableau(1)
        MsgBox Tableau(2)
    End Sub
    
    

    0
  4. Vous n’avez pas trouvé la réponse que vous recherchez ?

    Posez votre question
  5. cs_Le Pivert Messages postés 8437 Statut Contributeur 730
     
    Voilà un petit exemple en vba, les mots ne sont pas coupés:

    http://www.cjoint.com/c/EIfn1paPfvQ
    0
    1. saab.16
       
      Merci beaucoup dans l'idée ça fonctionne, je n'arrive pas à avoir 50 caractères maximum par cellule.
      Si le nombre de caractère est > 50, alors revenir au dernier espace.

      J'apprécie ton aide
      0
  6. cs_Le Pivert Messages postés 8437 Statut Contributeur 730
     
    Essaie ceci:

    Option Explicit
    Private Sub CommandButton1_Click()
    Columns("A").EntireColumn.AutoFit
    Columns("B:C").ColumnWidth = 55
      couperLignes
     End Sub
    Sub couperLignes()
        Dim lig As Long, i As Long, pos As Long
        Application.ScreenUpdating = False
        For lig = Cells(Rows.Count, "A").End(xlUp).Row To 1 Step -1
            i = 0
            Do While Len(Cells(lig + i, "A")) > 50
                pos = InStrRev(Cells(lig + i, "A"), " ", 51)
                Cells(lig + i + 1, "C") = Mid(Cells(lig + i, "A"), pos)
                Cells(lig + i, "B") = Left(Cells(lig + i, "A"), pos - 1)
                i = i + 1
            Loop
        Next lig
        Application.ScreenUpdating = True
    End Sub
    Private Sub CommandButton2_Click()
    Columns("A:C").ColumnWidth = 10.71
    Columns("B:C").ClearContents
    End Sub
    

    0
    1. cs_Le Pivert Messages postés 8437 Statut Contributeur 730
       
      Correction:

      Option Explicit
      Private Sub CommandButton1_Click()
      Columns("A").EntireColumn.AutoFit
      Columns("B:C").ColumnWidth = 55
        couperLignes
       End Sub
      Sub couperLignes()
          Dim lig As Long, i As Long, pos As Long
          Application.ScreenUpdating = False
          For lig = Cells(Rows.Count, "A").End(xlUp).Row To 1 Step -1
              i = 0
              Do While Len(Cells(lig + i, "A")) > 50
                  pos = InStrRev(Cells(lig + i, "A"), " ", 51)
                  Cells(lig + i, "C") = Mid(Cells(lig + i, "A"), pos)
                  Cells(lig + i, "B") = Left(Cells(lig + i, "A"), pos - 1)
                  i = i + 1
              Loop
          Next lig
          Application.ScreenUpdating = True
      End Sub
      Private Sub CommandButton2_Click()
      Columns("A:C").ColumnWidth = 10.71
      Columns("B:C").ClearContents
      End Sub
      
      0
    2. saab.16
       
      C'est bon pour moi ça fonctionne !

      Merci beaucoup.
      0