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

CBrd

XLDnaute Nouveau
Bonjour,

Je viens solliciter votre aide aujourd'hui car j'ai un problème que je n'arrive pas à résoudre.

Dans l'entreprise où je travaille nous avons une assez grosse base de données, surtout concernant les composants.
Aujourd'hui nous voudrions modifier massivement les désignations afin de les uniformiser. Pour ce faire, j'isole chaque partie de la désignation (les ohms, la tolérance [%], etc.) pour ensuite bien remettre toutes ses valeurs dans l'ordre souhaité par la société. Pour la plupart des valeurs j'arrive à les isoler et les récupérer pour modifier la désignation (grâce aux fonctions TROUVE, CHERCHE et DROITE par exemple)

Le problème est que dans la quasi totalité des désignations nous avons une valeur que l'on appelle un boitier. Dans mon exemple, ce boitier sera toujours une suite de 4 chiffres (sur d'autres composants plus spécifiques ce pourrait être autre chose). Le problème aussi est que la suite de 4 chiffres ne se trouve pas forcément toujours au même endroit.

Sur le fichier ci-joint, pour la première ligne de mon tableau je souhaiterais récupérer la valeur 0805.
Que pouvez-vous me conseiller pour pouvoir extraire cette suite ?

Merci par avance.
 

Pièces jointes

  • Exemple désignation.xlsx
    10.5 KB · Affichages: 19
Solution
Re

Une autre fonction personnalisée utilisant RegEx.
VB:
Function QUATRE(s As String) As Double
With CreateObject("vbscript.regexp")
  .Pattern = "\d{4}"
  If .Test(s) Then QUATRE = CDbl(.Execute(s)(0))
End With
End Function

EDITION 1: Bonsoir patricktoulon
EDITION 2: Bonsoir laurent950

jmfmarques

XLDnaute Accro
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 Accro
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 Barbatruc
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+
 

Pièces jointes

  • Extract(1).xlsm
    18.1 KB · Affichages: 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
 

Pièces jointes

  • Exemple désignation_V0.xlsm
    24.1 KB · Affichages: 3

patricktoulon

XLDnaute Barbatruc
re
@Staple1600
Capture.JPG
 

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:

 

Discussions similaires

Réponses
11
Affichages
618

Statistiques des forums

Discussions
311 715
Messages
2 081 822
Membres
101 821
dernier inscrit
hybroxis