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

patricktoulon

XLDnaute Barbatruc
pour le teste de celle de job ca va tellement vite que je ne vois pas de différence
un timer ferait peut être la différence mais pas de beaucoup a mon avis

j'ai bien testé en modifiant une donnée en B et c'est bien toute la C qui est recalculée
 

patricktoulon

XLDnaute Barbatruc
re
j'ajoute pour le modèle d'Amilo que l'on pourrait isoler les chaines \d{4} isolée des éventuelles chaine de 4 non isolées
VB:
Public regex As Object
Public Function RegExpExtract(Text As Range, Pattern As String, Optional Item As Integer = 1) As String
    If regex Is Nothing Then Set regex = CreateObject("VBScript.RegExp")
    regex.Pattern = "(\s)(" & Pattern & ")\s": regex.Global = True
        Set matches = regex.Execute(Text.Value)
        If matches.Count > 0 Then RegExpExtract = Trim(matches(Item - 1))
        With Sheets("Exemple").ListObjects("Tableau2")
            If .ListRows(.ListRows.Count).Range.Row = [B:B].End(xlUp).Row Then Set regex = Nothing: MsgBox "l'object a été detruit "
        End With
End Function

Amilo tu m'a forcé a tricoter un concat pour le pattern
tu aurais du mettre "\s(\d{4})\s" en [ I2 ]
 

Staple1600

XLDnaute Barbatruc
Enrichi (BBcode):
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
que l'on pourrait isoler les chaines \d{4}

VB:
Public regex As Object
Public Function RegExpExtract(Text As Range, Pattern As String, Optional Item As Integer = 1) As String
    If regex Is Nothing Then Set regex = CreateObject("VBScript.RegExp")
    regex.Pattern = "(\s)(" & Pattern & ")\s": regex.Global = True
        Set matches = regex.Execute(Text.Value)
        If matches.Count > 0 Then RegExpExtract = Trim(matches(Item - 1))
        With Sheets("Exemple").ListObjects("Tableau2")
            If .ListRows(.ListRows.Count).Range.Row = [B:B].End(xlUp).Row Then Set regex = Nothing: MsgBox "l'object a été detruit "
        End With
End Function
...:rolleyes:
 

laurent950

XLDnaute Accro
Je ferais comme cela Patrick

Ps : https://docs.microsoft.com/fr-fr/do...how-to-strip-invalid-characters-from-a-string
VB:
Sub ChapII_A_2_b_V1()
' Cocher : Menu Outils > Reférences > Microsoft VBScript Regular Expressions
' II-A-2-b
Dim Chaine As String
    Chaine = Cells(22, 2)

'Dim reg As VBScript_RegExp_55.RegExp
'Dim Match As VBScript_RegExp_55.Match
'Dim Matches As VBScript_RegExp_55.MatchCollection

' instanciation
    'Set reg = New VBScript_RegExp_55.RegExp
    Set reg = CreateObject("VBScript.RegExp")

reg.Pattern = "(\d.*\d[\%])"  '"(\s\d\s)(\d?\d[^\w\.@-])" / reg.Pattern = "[B]^[/B](\d.*\d[\%])\s"
' Paramétrage :
    reg.MultiLine = False ' ............ Active ou non la recherche sur plusieurs lignes à la fois.
    reg.IgnoreCase = False ' ........... Précise si la recherche est sensible ou non à la casse (majuscules/minuscules).
    reg.Global = True ' ................ Précise si la recherche porte sur la première occurence ou sur toutes.
' Test si pattern Trouvé
    MsgBox reg.Test(Chaine)
' Progamme
Set Matches = reg.Execute(Chaine) ' reg.Execute("capacité")
    reg.Pattern = "(\d{4})"
    Set Matches = reg.Execute(Chaine)
For Each Match In Matches
    Debug.Print "source >>", Match.Value
    MsgBox "source >> " & Match.Value
    For i = 0 To Match.SubMatches.Count - 1
        Debug.Print "[$" & i + 1 & "]", Match.SubMatches(i)
        MsgBox "[$" & i + 1 & "] " & Match.SubMatches(i)
    Next i
Next Match
' libération d'objets
    Set Matches = Nothing
    Set Match = Nothing
    Set reg = Nothing
End Sub

Pourquoi tu ajoutes un espaces aprés le % il n'y a pas besoin : reg.Pattern = "^(\d.*\d[\%])\s"
et aussi Pourquoi au debut Puisque cela peux être n'importe ou ?
Le problème aussi est que la suite de 4 chiffres ne se trouve pas forcément toujours au même endroit.
 

Pièces jointes

  • Exemple désignation.xlsm
    18.7 KB · Affichages: 3

Discussions similaires

Réponses
11
Affichages
618