Extraire mot

Résolu/Fermé
Saab16 - 4 sept. 2015 à 17:54
 saab.16 - 7 sept. 2015 à 14:01
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

Mike-31 Messages postés 18337 Date d'inscription dimanche 17 février 2008 Statut Contributeur Dernière intervention 27 septembre 2024 5 100
4 sept. 2015 à 18:02
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
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
cs_Le Pivert Messages postés 7904 Date d'inscription jeudi 13 septembre 2007 Statut Contributeur Dernière intervention 14 août 2024 729
4 sept. 2015 à 18:36
0
J'ai un peu de mal à utiliser la requête.
Je ne sais pas où mettre mes données d'origine ni le chemin de destination, as-tu des précisions ?
0
nihcoc Messages postés 192 Date d'inscription dimanche 9 mars 2014 Statut Membre Dernière intervention 28 février 2023 5
4 sept. 2015 à 19:29
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
cs_Le Pivert Messages postés 7904 Date d'inscription jeudi 13 septembre 2007 Statut Contributeur Dernière intervention 14 août 2024 729
4 sept. 2015 à 19:31
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

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

Posez votre question
cs_Le Pivert Messages postés 7904 Date d'inscription jeudi 13 septembre 2007 Statut Contributeur Dernière intervention 14 août 2024 729
5 sept. 2015 à 15:55
Voilà un petit exemple en vba, les mots ne sont pas coupés:

http://www.cjoint.com/c/EIfn1paPfvQ
0
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
cs_Le Pivert Messages postés 7904 Date d'inscription jeudi 13 septembre 2007 Statut Contributeur Dernière intervention 14 août 2024 729
7 sept. 2015 à 12:14
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
cs_Le Pivert Messages postés 7904 Date d'inscription jeudi 13 septembre 2007 Statut Contributeur Dernière intervention 14 août 2024 729
7 sept. 2015 à 12:19
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
C'est bon pour moi ça fonctionne !

Merci beaucoup.
0