Isoler une partie de texte d'une cellule avec position variable ?

[DukeDevlin]

Bonjour,

Je viens vers vous aujourd'hui pour avoir vos lumières. En effet, vous trouverez en PJ un tableau expliquant mon problème. J'ai une cellule contenant un descriptif assez long. Et j'aimerais isoler 2 références à partir de ce descriptif : Le NCA et le NCR. Je sais que le NCA a 4 chiffres et le NCR 5 chiffres et que l'un comme l'autre peuvent être placés qu'au début (à gauche) et non pas à la fin. Le problème, c'est que la nomenclature utilisée peut changer d'une cellule à une autre comme joint dans l'exemple, sinon cela serait trop facile et il suffirait d'utiliser la fonction GAUCHE. Avez-vous une idée pour que je clean le fichier en faisant ressortir les NCA et NCR pour chaque descriptif dans deux nouvelles colonnes ? Je pense que cela sera plus parlant avec l'exemple.

Merci à vous. Bonne journée.

 

[jmfmarques]

dans mon raisonnement je suis plus dur
je shunte sans distinction tout sauf les [0-9]
régule avec app.trim , split , garde les bons
terminé

Et tu ne te rends pas compte de ce que c'est là ce que fait le code que j'ai montré, aux 2 seules différences que /
- tu parcours par mid (plus lourd) et moi dans un array
- tu remplaces par des " " ce que je remplace par des chr(1)
Je n'ose par ailleurs pas te dire que ton "trim" ne fait rien d'autre qu'ignorer en arrière plan et selon le même principe, les vides qu'ignore le parcours du résultat "lavé"

Bon ... pas trop grave car seulement 5000 lignes. La différence commencerait à peser avec un plus grand nombre de lignes à traiter.

 

[patricktoulon]

heu ...jmfmarques
peut être que le split de ton converse unicode est moins lourd mais désolé de te le dire , il ne fait pas le job

ton truc

ce que souhaite le demandeur

je peux préter mes lunettes le cas échéant

on peu meme dire qu'il te sera impossible de faire le job avec ta méthode a moins de tordre et de faire des va et viens dans ton code pour un résultat cohérent avec la demande
sachant que tu boucle et récup les numérique il ne t'est plus possible de différencier les extrémités des sous chaîne correctement si il y avait q'une chaine a récupérer oui mais la il peut y en avoir deux voir + on sais pas

 

[jmfmarques]

ah ... tu t'amuses à faire commencer directement par un élément ?
alors même ainsi --->> on le prévoit pour 2 sous en écrivant :

titi = Split(StrConv(" " & ch & " ", vbUnicode), Chr(0)) [\CODE]

NCA 1234 NCR 12345 La vie est belle	12345	1234
3456 78901 vraiment belle	78901	3456
9876 trop super génial		9876
56789 / 09876 incroyablement c'est dingue	56789-09876
99999 oui	99999
1010.1050 je ne sais pas		1010-1050
1034.32145 ok	32145	1034
C'est vraiment super 3456		3456
Exemple
56789.1004	56789	1004

 

[patricktoulon]

re
là oui je suis d'accords ça fait le job

alors toi tu converti vbunicode et split
et boucle sur titi soit pour la 1ere ubound(titi)=36( =lau len) en remplaçant tout ce qui n'est pas numerique par le caractere mort chr(1)

ensuite tu re split le join de ton titi pour boucler sur les chr(1) et tu a tes segments

moi
je boucle directe sur len soit 36 aussi et remplace tout ce qui n'est pas numérique
ensuite je re split par le trim du replace et j'ai mes segment

en gros je saute la convertion vbunicode

je voudrais être une petite diode dans mon proc pour voir si dans ce contexte de chaîne 10/40 caractères c'est vraiment plus rapide
mais bon ca a l'air de fonctionner

donc celles qui font le job

jmfmarques
Public Function extrait(ch As String, n As Integer) As String
  Dim k As Long, flt As String, titi
  flt = String(n, "#")
  'titi = Split(StrConv(ch, vbUnicode), Chr(0))
  titi = Split(StrConv(" " & ch, vbUnicode), Chr(0))
  For i = 0 To UBound(titi) - 1
   If Not IsNumeric(titi(i)) Then titi(i) = Chr(1)
  Next
  titi = Split(Join(titi, ""), Chr(1))
  For k = 1 To UBound(titi)
    If titi(k) Like flt Then
      extrait = extrait & "-" & titi(k)
    End If
  Next
  extrait = Mid(extrait, 2)
End Function

'mapomme
Function NcaNcr(x As String, q As Integer)
Dim s$, t, i&, r$

s = Replace(Replace(LCase(x), "ncr", " "), "nca", " ")
s = Replace(s, "&", " ")
s = Replace(s, """", " ")
s = Replace(s, "'", " ")
s = Replace(s, "{", " ")
s = Replace(s, "(", " ")
s = Replace(s, "[", " ")
s = Replace(s, "-", " ")
s = Replace(s, "|", " ")
s = Replace(s, "`", " ")
s = Replace(s, "_", " ")
s = Replace(s, "\", " ")
s = Replace(s, "^", " ")
s = Replace(s, ")", " ")
s = Replace(s, "@", " ")
s = Replace(s, ")", " ")
s = Replace(s, "]", " ")
s = Replace(s, "°", " ")
s = Replace(s, "+", " ")
s = Replace(s, "=", " ")
s = Replace(s, "}", " ")
s = Replace(s, "/", " ")
s = Replace(s, ",", " ")
s = Replace(s, "?", " ")
s = Replace(s, ".", " ")
s = Replace(s, ";", " ")
s = Replace(s, ":", " ")
s = Replace(s, "/", " ")
s = Replace(s, "!", " ")
s = Replace(s, "-", " ")
s = Application.Trim(s)
t = Split(s)
For i = 0 To UBound(t)
   If Not IsNumeric(t(i)) Then Exit For
   If Len(t(i)) = q Then r = LTrim(r & " " & t(i))
Next i
NcaNcr = Replace(r, " ", " / ")
End Function

'patricktoulon'
Function les_nombres(cel As String, nombre)
Dim i&, T, x$
For i = 1 To Len(cel):  Mid(cel, i, 1) = IIf(Not IsNumeric(Mid(cel, i, 1)), " ", Mid(cel, i, 1)): Next
cel = Application.Trim(cel)
T = Split(cel, " ")
For i = 0 To UBound(T): x = x & IIf(Len(T(i)) = nombre, T(i) & " ", ""): Next
les_nombres = IIf(x = 0, "", x)
End Function

'patricktoulon'
Function les_4_ou_5_faut_savoir(var As String, longueur As Long)
    Dim t, x$
    With CreateObject("VBScript.RegExp"):
        .Global = True: .IgnoreCase = True
        .Pattern = "[A-z]": var = " " & .Replace(var, " ")    'suppression des[26]de  l'alphabet
        .Pattern = "[\.|\/|;|:|,|!|\\|'|é|è|à|û|ü|ê|ë]|[^\w]": var = " " & .Replace(var, " ")    'supression des caracteres particuliers
        var = Application.Trim(var)    'app.trim (1 seul espace comme separateur)
        t = Split(var, " ")
        For i = 0 To UBound(t): x = x & IIf(Len(t(i)) = longueur, t(i) & " ", ""): Next
    End With
    les_4_ou_5_faut_savoir = Trim(x)
End Function

 

[jmfmarques]

Je te montrerai demain comment on peut le faire plus vite et sans strconv, ni split ni trim (en jouant à la marelle)

EDIT : et puisque j'en ai trouvé le temps --->>

Public Function extrai(ch As String, n As Integer) As String
  extrai = " " & Replace(ch, " ", "") & " "
  flt = "[!0-9]" & String(n, "#") & "[!0-9]*"
  Do While Len(extrai) >= n
   If extrai Like flt Then
     toto = toto & "-" & Mid(extrai, 2, n)
     extrai = Mid(extrai, n + 1)
   Else
     extrai = Mid(extrai, 2)
   End If
  Loop
  extrai = Mid(toto, 2)
End Function

Bonne nuit

 

[DukeDevlin]

Je teste toutes vos solutions Lundi, merciii de me donner le choix ahaha !

 

[patricktoulon]

j'avoue bien aimer ces trucs
on est très proche d'un regex /matchs là
pattern =
flt = "[!0-9]" & String(n, "#") & "[!0-9]*"

matchs=
Do While Len(extrai) >= n
If extrai Like flt Then
--> réduction de chaine
-->récupe et retourne

elle me plait bien celle là

 

[mapomme]

Bonsoir ou bonjour,

J'ai fait un fichier pour comparer les résultats demandés (message #1 du demandeur) , les deux fonctions de @jmfmarques, la fonction du post #29 de @patricktoulon.
J'avoue que j'ai pu me planter avec cette succession pléthorique de messages. Dans ce cas, n'hésitez pas à m'eng...ler.
Sont joints un fichier et une image.

Attendons maintenant lundi, pour savoir ce que tout cela donne sur le fichier du demandeur.

Allez, bonnet de nuit à tous

 

[patricktoulon]

Bonjour @mapomme
oui je suis une interrogatif sur la ligne qui est soustraite ligne 11 N°8

y aurait il quelque chose que nous aurions pas saisi

 

[mapomme]

Bonjour dominical @patricktoulon ,

Le demandeur a dit dans son premier message:

Je sais que le NCA a 4 chiffres et le NCR 5 chiffres et que l'un comme l'autre peuvent être placés qu'au début (à gauche) et non pas à la fin

Cela doit être le cas pour le texte : C'est vraiment super 3456.
Tout ça est à confirmer par @DukeDevlin à compter de lundi prochain...
Avec 3000 lignes à traiter, on risque d'avoir d'autre cas "tordus"

 

[Staple1600]

Bonjour le fil

Ligne 11, N°8
C'est une ligne de bus, non ?
Parce que sur la jolie photo (message#54), mes yeux lisent:
Ligne 10, N°9

OK je sors

 

[patricktoulon]

re

Ah tu commence de bon matin un dimanche
celle avec regex corrigée le cas échéant

Option Explicit
Function les_4_ou_5_faut_savoir(var As String, longueur As Long)
    Dim t, x$, i&, oldvar$
    oldvar = var
    With CreateObject("VBScript.RegExp"):
        .Global = True: .IgnoreCase = True
        .Pattern = "[A-z]": var = " " & .Replace(var, " ")    'suppression des[26]de  l'alphabet
        .Pattern = "[\.|\/|;|:|,|!|\\|'|é|è|à|û|ü|ê|ë]|[^\w]": var = " " & .Replace(var, " ")    'supression des caracteres particuliers
        var = Application.Trim(var)    'app.trim (1 seul espace comme separateur)
        t = Split(var, " ")
        For i = 0 To UBound(t): x = x & IIf(Len(t(i)) = longueur And Right(oldvar, longueur) <> t(i), t(UBound(t)) & " ", ""): Next
    End With
    les_4_ou_5_faut_savoir = Trim(x)
End Function

 

[jmfmarques]

Je n'avais pas vu que l'élément ne saurait être à la fin de la chaîne.
Il suffit dans ce cas d'enlever un & " " dans mes codes.
Prenons par exemple le code "marelle" (le dernier :

extrai = " " & Replace(ch, " ", "") & " "

à remplacer tout simplement par

extrai = " " & Replace(ch, " ", "")

 

[patricktoulon]

bonjour jmfmarques
je ne l'ai compris entièrement que ce matin ta marelle je n'avais pas fait attention au "*" a la fin du pattern
qui fait que ca match pour le premier avec (2,n) ca me triturait depuis hier

If extrai Like flt Then
     toto = toto & "-" & Mid(extrai, 2, n)
  '...

'traduction:"[autre char que numerique]" & chaine numerique de n nombres fixe  & "[autre char que numerique]et le reste"
  flt = "[!0-9]" & String(n, "#") & "[!0-9]*" 'demare par une chaine numerique de n nombres explicitement

 

[jmfmarques]

je ne l'ai compris entièrement que ce matin ta marelle

Alors tu connais maintenant la raison du qualificatif que je lui ai donné ("marelle").

Pour mieux comprendre, aller jusqu'au bout de cela :