Extraire le premier ou les 2 premiers mots d'une cellule

Bonjour tout le monde,

J'ai besoin d'aide pour extraire dans certains cas juste le premier mots de la colonne H et dans d'autres cas le premier et le deuxième mot.

Exemple : Dans la Cellule H150 j'ai besoin d'extraire AM SERRURERIE et dans la Cellule H155 je n'ai besoin que de BOULANGER.

Il s'agit d'ajouter une colonne dans laquelle il faut extraire uniquement le nom du prestataire du libellé comptable (Colonne H).

Je vous remercie énormément pour votre aide.

44fournitures.xlsx (93.02 Ko)

Bonsoir Sabrineagh et

Quelle est la règle, le signe, etc. qui permettra de déterminer si on doit extraire le texte devant le premier ou le second espace ?

Si on veut automatiser cette extraction, il faut bien qu'on puisse vérifier quelque chose, trouver un élément qui permet de savoir si on extrait 1 ou 2 mots

Justement il n'y en a pas il faudrait demander aux comptables de changer leur façon de saisir les factures parce que le tableau c'est une extraction par un business intelligence des données saisies dans sage auxquels moi j'ai pas accès.

Mais je sais que le nom du prestataire est toujours écrit en majuscule donc ce qui n'est pas en majuscules on ne le prend pas

Bonsoir tout le monde,

que fait-on quand il n'y a pas de mot en majuscule ou si ce mot est bien après la deuxième position?

A+

Salut,

  • sauf indications contraires, tous les mots en majuscule sont repris... ;
  • ... même si il y en a plus que 2 ;
  • ... même si il se trouve tout perdu tout seul après la deuxième position ;
  • le libellé originel est repris si il n'y a pas de mots en majuscule.

La macro réagit si :

  • sur un ou plusieurs changement(s) dans la colonne [H:H] ;
  • sur un double-clic en [H1], toute la colonne est traitée.
Public Sub Extraire(tData, iRow%, sData As String)
'
For x = 0 To UBound(tData)
    If Len(tData(x)) > 1 Then
        If Asc(Mid(tData(x), 2, 1)) > 64 And Asc(Mid(tData(x), 2, 1)) < 91 Then _
                sMsg = sMsg & IIf(sMsg = "", tData(x), Chr(32) & tData(x))
    End If
Next
Cells(iRow, 9) = IIf(sMsg = "", sData, sMsg)
'
End Sub

A+

49fournitures.xlsm (99.16 Ko)

J'arrive pas à lancer la macro, et VBA je ne sais pas encore le manipuler

Salut,

après avoir chargé le fichier, tu n'as rien d'autre à faire qu'à effectuer un changement ou l'autre en colonne [H:H] ou faire un double-clic en [H1] pour que la macro produise ses effets.

A+

Salut,

Merci beaucoup ça a fonctionné

Merci tout le monde pour votre aide vous êtes géniaux §§§§

Salut Sabrineagh,

voilà ton fichier que, accessoirement, je m'en rends compte maintenant, j'avais programmé comme un âne...

Enfin...

  • même principe, tu double-cliques n'importe où dans la colonne affichant 'Libelle ecriture' ou tu y opères un changement quelconque ;
  • la macro se charge de tout : repérage de la bonne colonne 'Libelle ecriture' et, évidemment, de la colonne 'Extract'.

Tu devrais remarquer une belle différence de vitesse de traitement avec la (très mauvaise) version précédente!

Public Sub Extraction(ByVal sCol1 As String, sCol2 As String)
'
Dim tData, tSplit, tExtract()
Dim iRow%, iIdx%, sData As String
'
Application.EnableEvents = False
Application.ScreenUpdating = False
'
tData = Range(sCol1 & "2:" & sCol1 & Range(sCol1 & Rows.Count).End(xlUp).Row).Value
Range(sCol2 & "2:" & sCol2 & Range(sCol2 & Rows.Count).End(xlUp).Row).ClearContents
For iRow = 1 To UBound(tData, 1)
    sData = CStr(tData(iRow, 1))
    tSplit = Split(CStr(tData(iRow, 1)), " ")
    iIdx = iIdx + 1
    ReDim Preserve tExtract(iIdx)
    tExtract(iIdx - 1) = fctExtraire(tSplit, sData)
Next
Range(sCol2 & 2).Resize(iIdx, 1) = WorksheetFunction.Transpose(tExtract)
Columns(sCol2 & ":" & sCol2).AutoFit
'
Application.ScreenUpdating = True
Application.EnableEvents = True
'
End Sub

Public Function fctExtraire(tSplit, sData As String)
'
For x = 0 To UBound(tSplit)
    If Len(tSplit(x)) > 1 Then
        If Asc(Mid(tSplit(x), 2, 1)) > 64 And Asc(Mid(tSplit(x), 2, 1)) < 91 Then _
                sMsg = sMsg & IIf(sMsg = "", tSplit(x), Chr(32) & tSplit(x))
    End If
Next
fctExtraire = IIf(sMsg = "", sData, sMsg)
'
End Function

A+

28fournitures.xlsm (99.08 Ko)

Salut curulis57

Merci beaucoup ça marche mieux maintenant :

Rechercher des sujets similaires à "extraire premier premiers mots"