Résolu XL 2019 Extraire une suite de 4 chiffres dans une désignation

laurent950

XLDnaute Accro
Merci PatricToulon, Merci Staple1600

Bonne nuit Staple1600 et un grand Merci

Ps : Merci aussi PatrickToulon
 

Staple1600

XLDnaute Barbatruc
Re

•>patricktoulon
La question m'était destinée, non ? :rolleyes:
(cf message#39)
mais bon comme je vais me coucher, je te laisse répondre à ma place.
;)
 

Staple1600

XLDnaute Barbatruc
Re

Oui, d'où justement les émoticones dans le message#42

Sur ce bonne nuit.
et à demain pour un deuxième vendredi de confinement !!!
;)
 

jmfmarques

XLDnaute Impliqué
Coucou
il me semble avoir eu il y a très peu de temps l'occasion de lire ceci :
il a été démontré encore récemment sur le forum dans deux discussion qu'il pouvait avoir son utilité
bien que des solutions sans!!! ont été trouvées au prix de plusieurs journées d’échange
et je vous regarde avec beaucoup d'attention et étonnement
 

Staple1600

XLDnaute Barbatruc
Bonjour le fil, jmfmarques

J'ai fini par ouvrir la PJ du message#1
(j'aurais pas du, car je suppute que la formule ci-dessous ne fonctionnera pas en vrai, sur le fichier original)
Mais en tout cas, elle fonctionne sur le fichier exemple ;)


=STXT(Tableau2[@DESIGNATION];SIERREUR(CHERCHE(" ?%";Tableau2[@DESIGNATION]);CHERCHE(" ?.?%";Tableau2[@DESIGNATION]))-4;4)

 

jmfmarques

XLDnaute Impliqué
Bonjour Staple
Merci pour cette formule qui m'éclaire (je n'ouvre pas les classeurs tiers)
Ce que tu écris là me donne donc à penser que tu traites un tableau structuré dont les lignes sont de la forme :
* #### ?% *
est-ce bien le cas ?
Amitiés
 

Staple1600

XLDnaute Barbatruc
Re,

Après RegExp, après les formules, tout confiné que je suis, m'est revenu en tête, en mangeant ma banane... ;)
VB:
Sub Extraire_Designation()
Dim i&, j&, vDesign$, c As Range, vTxt
For Each c In Selection
Application.ScreenUpdating = False
i = 1: vTxt = Split(c)
For j = 0 To UBound(vTxt)
    vDesign = vTxt(j)
    If IsNumeric(vDesign) And Len(vDesign) = 4 Then
        Select Case Left(vDesign, 1)
        Case 0: c.Offset(, i) = "'" & vDesign
        Case Else: c.Offset(, i) = vDesign
        End Select
    c.Offset(, i).NumberFormat = "@": i = i + 1
    End If
    Next
Next
End Sub

•>jmfmarques
Ci-dessous exemples de désignation
CMS Res. Thin (couche mince) 0402 1% 1/16W 16,2k ohm
CMS Res. 0805 1% 1/8W 1.96 KOHM - RC0805FR-071K96L
CMS Res. 1812 1% 150R - ERJU12F1500U
(qui se trouve dans la colonne B d'un tableau "structuré" contenant deux colonnes)
 

Staple1600

XLDnaute Barbatruc
Re

•>Spécial dédicace pour laurent950;)
Voici un petit pattern (toi qui raffole de RegExp) cueilli à la fraiche dans les sous-bois de mon HD ;)
NB: patricktoulon se fera une joie de le décortiquer (lol)
Moi il faut que j'aille me confiné ailleurs :eek:


VB:
Function X_DESIGN(Chaine$) As String
With CreateObject("vbscript.regexp")
.Pattern = "(?:\d+\.\d+)|(?:\b|\D)(\d{4})(?:\b|\D)": .Global = -1
X_DESIGN = .Execute(Chaine)(0).submatches(0)
End With
End Function
 

cp4

XLDnaute Impliqué
Re
Apparemment la cape d'invisibilité est retombée sur mes épaules
:rolleyes:
(cf message#6 et #9)
Bonjour à toute l'équipe;),
@Staple1600 : Décidément, je croyais que ce que tu m'avais dit, était valable pour tout le monde.
"On repart sur de bonne base".
L'autre jour sur ma discussion, j'ai été tellement submergé par les réponses des différents contributeurs que je n'arrivais plus à suivre. Donc, si on zappe un post, je pense que c'est pas prémédité.
Il faut être indulgent;) Staple1600.
Bonne journée et bon week-end anticipé bien confiné:cool:
 

job75

XLDnaute Barbatruc
Bonjour le fil, le forum,

Cette fonction classique fait le même travail que RegExp ferait :
VB:
Function Extract$(t$, n%)
Dim i%
t = "a" & Replace(t, " ", "a")
For i = 2 To Len(t) - n + 1
    If Mid(t, i, n) Like String(n, "#") Then If Not (IsNumeric(Mid(t, i - 1, 1)) Or IsNumeric(Mid(t, i + n, 1))) Then Extract = Mid(t, i, n): Exit Function
Next
End Function
Notez que la chaîne de n chiffres recherchée ne doit pas être précédée ou suivie d'un chiffre.

Fichier joint, testé sur 27 000 lignes le recalcul s'effectue en 0,28 seconde chez moi.

A+
 

Fichiers joints

Staple1600

XLDnaute Barbatruc
Re, Bonjour job75

En attendant que CBrd se manifeste et nous informe quelle solution il a retenu, une autre formule (testée sur la PJ du message#1)
Formule non matricielle
=GAUCHE(REMPLACER(B2;1;MIN(CHERCHE({0.1.2.3.4.5.6.7.8.9};B2&"0123456789"))-1;"");4)
 

laurent950

XLDnaute Accro
Hello Patricktoulon et Staple1600

Pour Patricktoulon

VB:
Sub Extraction()
    Set reg = CreateObject("VBScript.RegExp")
    Dim TabChaine As Variant
    TabChaine = Range(Cells(2, 2), Cells(28, 2))
        ReDim Preserve TabChaine(LBound(TabChaine, 1) To UBound(TabChaine, 1), LBound(TabChaine, 2) To UBound(TabChaine, 2) + 1)
For i = LBound(TabChaine, 1) To UBound(TabChaine, 1)
     reg.Pattern = "(\d{4})(\s)(\d.*\d[\%]*)"
    ' Paramétrage :
        reg.MultiLine = False: reg.IgnoreCase = False: reg.Global = False ' : MsgBox reg.Test(TabChaine(1, 1))
    ' Progamme
    Set Matches = reg.Execute(TabChaine(i, 1)) ' reg.Execute("capacité")
    For Each Match In Matches
        TabChaine(i, 2) = Match.SubMatches(0)
    Next Match
Next i
    ' Resultat
    Cells(2, 4).Resize(UBound(TabChaine, 1), 1) = Application.Index(TabChaine, , 2): Cells(1, 4) = "Resultat"
End Sub
Cf : fichier joint premiére ligne :
reg.Global = False Ou True (Même résultat avec)
CMS Res. 0805 1% 1/8W 0.1 ohm - CRL0805-FW-R100ELF CMS Res. CMS Res. 0805 1% 1/8W 0.1 ohm - CRL0805-FW-R100ELF CMS Res.

' Variation du Parémetrage du Pattern :
reg.Global = Résultat 1 Item (Ok Fonctionne bien)
reg.Global = Résultat attendu 2 Item (Mais juste 1 seul est-ce du au Pattern avec découpage) ?

Car astuce de découpage du Pattern : (Ci-dessous)
3 blocs / Pattern "(\d{4})(\s)(\d.*\d[\%]*)"
Bloc 1 = "(\d{4}) soit notre recherche donc la cible !
Bloc 2 = (\s) Soit 1 espace
Bloc 3 = (\d.*\d[\%]*) Soit ce qui est qualifier de % Pour 1 % comme 0,5%
Facile ensuite d'extraire le Bloc qui nous interresse
TabChaine(i, 2) = Match.SubMatches(0) qui correspond à se bloc (\d{4})

Laurent
 

Fichiers joints

patricktoulon

XLDnaute Barbatruc
re
décidément ca rentre pas chez toi Laurent hein je vais être obligé de sévir ;) ;) ;)
d’après toi
avec "0805"
que va faire ceci

For Each Match In Matches
TabChaine(i, 2) = Match.SubMatches(0)
Next Match


que se passe t il quand on rentre une valeur numérique commençant par zero et que son entier est supérieur a 0 dans une variable tableau

je désespère :confused:o_O:oops::rolleyes:

 

Créez un compte ou connectez vous pour répondre

Vous devez être membre afin de pouvoir répondre ici

Créer un compte

Créez un compte Excel Downloads. C'est simple!

Connexion

Vous avez déjà un compte? Connectez vous ici.

Haut Bas