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

[CBrd]

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.

 

[patricktoulon]

Re,

Merci patricktoulon pour l'optimisation du code, finalement j'oublie l'histoire du camion surchargé pour le RegEx ,

Bonne soirée à tous

ça c'est parce que tu a Laurent comme proff Laurent expert en code a rallonge hhihihihihihihihihi
Avec Laurent quand yen a plus ben yen a encore

 

[laurent950]

Hi Hi Hi n'empêche j'ai des idées à Rallonge hi hi hi

 

[Staple1600]

Re

Apparemment la cape d'invisibilité est retombée sur mes épaules

(cf message#6 et #9)

 

[patricktoulon]

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]

Re

Apparemment la cape d'invisibilité est retombée sur mes épaules

(cf message#7 et #9)

non on la vu du moins moi je l'ai vu Staple16+ 6*0 + 1600*0
perso je préfère l'argument pattern externe on réécrit pas la macro

 

[Amilo]

Re

Apparemment la cape d'invisibilité est retombée sur mes épaules

(cf message#7 et #9)

Staple1600, vous vouliez dire plutôt #6 et #9 non ?

Cordialement

 

[Staple1600]

Re

>•patricktoulon
Voir les choses seul sur son écran...
et Voir les choses puis en discuter entre membres du forum
Ce n'est pas tout à fait la même chose

>•Amilo
Merci, j'ai rectifié.

 

[patricktoulon]

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

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]

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}

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]

Re,
merci patricktoulon, ça m'a l'air plus robuste ,
Je vais sortir le pdf à Staple1600 joint dans l'autre fil pour m'instruire

Je quitte….bonne nuit à tous

 

[patricktoulon]

re
ok bonne nuit Amilo
@Staple1600 tu peux tant que tu veux tu n'isole rien du tout là ça le fait avec ces chaines mais ça n'est pas l'absolue teste avec ça ; normalement il ne devrait y avoir aucune occurrences pourtant tu va avoir 1289 avec la tienne
toto 128956 kk1234ddk12546 kjdkje15423

 

[Staple1600]

Re

•>patricktoulon
Ah ben, il faut du temps pour interagir avec bibi
NB: J'ai précise avec quel string j'ai testé dans le message#6
Et j'ai aussi précisé ce je n'ai pas fait (que j'aurai sans doute du faire)

 

[laurent950]

patrick je dirais plutôt que le paterne est le suivant
reg.Pattern = "(\d.*\d[\%])"
une fois récupérer
reg.Pattern = "(\d{4})"
Pour ciblé a coup sur

 

[patricktoulon]

re
dans ce cas la
reg.Pattern = "^(\d.*\d[\%])\s"
une fois récupérer
reg.Pattern = "(\d{4})"

ATTENTION LA NON PLUS ON EST PAS ABSOLU !!!!!!!!!!!!!!
si tu a blabla 1296756789 blbloblibloblu

après récup et match \d{4} (0) tu aura 1296

 

[laurent950]

Je ferais comme cela Patrick

Ps : https://docs.microsoft.com/fr-fr/do...how-to-strip-invalid-characters-from-a-string

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.