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.
 

Fichiers joints

sylvanu

XLDnaute Barbatruc
Supporter XLD
Bonsoir CBrd,
Un exemple en PJ avec une petite fonction perso :
VB:
Function Gabarit(Chaine)
Application.Volatile
Boitier = Array("0201", "0402", "0603", "0805", "1206", "1210", "1812", "2010", "2512")
liste = UBound(Boitier)
Gabarit = ""
For i = 0 To liste
    If Chaine Like "*" & Boitier(i) & "*" Then
        Gabarit = Boitier(i)
        Exit Function
    End If
Next i
End Function
Il suffit de changer l'array pour s'adapter aux transistors, diodes, IC ....
( si vous avez la liste de tous les gabarits, je vous l'adapte. Je pense que je ne me les rappelle pas tous surtout les QFP :) )
 

Fichiers joints

Dernière édition:

job75

XLDnaute Barbatruc
Bonsoir CBrd, bienvenue sur XLD, sylvanu, Amilo,

Formule matricielle en C2 du fichier joint :
Code:
=STXT(B2;EQUIV(VRAI;ESTNUM(-STXT(SUBSTITUE(B2;" ";"a");LIGNE(INDIRECT("1:"&NBCAR(B2)));4));0);4)
à valider par Ctrl+Maj+Entrée.

A+
 

Fichiers joints

job75

XLDnaute Barbatruc
Pour tester j'ai recopié le tableau sur 27 000 lignes, durées des recalculs :

- formules du post #3 => 29 secondes

- formules du post #4 => 0,75 seconde.

En effet dans la formule d'Amilo l'objet regex est recréé pour chaque formule, cela prend beaucoup de temps.

Il faut le créer une seule fois pour toutes les formules et le mémoriser.

Je ne compare pas la formule de sylvanu car elle elle traite quelques boîtiers et n'est donc pas générale.

A+
 

Staple1600

XLDnaute Barbatruc
Bonsoir le fil, CBrd, Amilo, sylvanu, job75

Une autre formule (non matricielle)
=-RECHERCHE(1;-STXT(SUBSTITUE(" "&A1;" ";"");LIGNE(INDIRECT("1:"&NBCAR(" "&A1)-4));4))
Test OK avec les chaines ci-dessous:
abcd1234efg
abcd1234efg
1234abcd
abc 1234 efg

PS: Je n'ai téléchargé aucune PJ
 

Amilo

XLDnaute Accro
Bonsoir job75, sylvanu, Staple1600, CBrd,

Merci job75 pour cette info sur le temps d'exécution, c'est bon à savoir,
C'est énorme la différence, cela rejoint ce que disait jmfmarques concernant la lenteur de RegEx dans mon précédent fil.

Cordialement
 

sylvanu

XLDnaute Barbatruc
Supporter XLD
Bonjour tout le monde,
Je connais bien cette problématique pour l'avoir traitée plusieurs fois.
Si la solution sied à CBrd, il va revenir avec d'autres gabarits de composants comme :
SOT23, SOT23-E, SOT89, SOT223, SO8, SO16, SO20, SSOP16, SSOP20, QFN14, PLCC20 , QFN32 ....
où lettres et chiffres vont s’entremêler.
C'est pour cela que j'ai opté pour un array. A terme ce sera plus souple.
C'est surement plus long en exécution, mais secondaire car ce sera un one shot.
 

Staple1600

XLDnaute Barbatruc
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
 
Dernière édition:

patricktoulon

XLDnaute Barbatruc
bonsoir a tous

j'ai repris le code regex de Amilo
testé sur 30 000 lignes
l'object est crée si il n'existe pas, il est détruit quand l'argument "text"=la dernière ligne en "B"
ben c'est instantané

VB:
Public regex As Object
Public Function RegExpExtract(Text As String, Pattern As String, Optional Item As Integer = 1) As String
'On Error GoTo ErrHandl
    If regex Is Nothing Then Set regex = CreateObject("VBScript.RegExp")
    regex.Pattern = Pattern: regex.Global = True
    If regex.test(Text) Then
        Set matches = regex.Execute(Text)
        RegExpExtract = matches(Item - 1)
        With Sheets("Exemple").ListObjects("Tableau2")
            If .ListRows(.ListRows.Count).Range.Cells(2).Value = Text Then Set regex = Nothing: MsgBox "l'object a été detruit "
        End With
    End If
End Function
seul inconvénient il ne faut pas de doublons avec la dernière ligne

la formule on change rien
edit
si on change le type de l'argument text en range on teste le row end et on fait ainsi abstraction des doublons

VB:
Public regex As Object
Public Function RegExpExtract(Text As Range, Pattern As String, Optional Item As Integer = 1) As String
'On Error GoTo ErrHandl
    If regex Is Nothing Then Set regex = CreateObject("VBScript.RegExp")
    regex.Pattern = Pattern: regex.Global = True
    If regex.test(Text.Value) Then
        Set matches = regex.Execute(Text.Value)
        RegExpExtract = 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 If
End Function
pour l'exemple dans les deux versions un msgbox s'affiche quand on est bien a la dernière ligne et que l'object "regex" va être détruit
je le redis chez moi c'est instantané sur 30000 lignes

je ne m'attarderais pas sur le fait de lancer 2 fois le regex a chaque cellule

If regex.test(Text.Value) Then
Set matches = regex.Execute(Text.Value)
RegExpExtract = matches(Item - 1)

je dirais simplement que le lancer une fois est bien suffisant le test se fera avec la matches.count
If regex.test(Text.Value) Then
Set matches = regex.Execute(Text.Value)
if matches.count > 0 RegExpExtract = matches(Item - 1)


et allez on gratte encore quelque centiemes

VB:
Public regex As Object
Public Function RegExpExtract(Text As Range, Pattern As String, Optional Item As Integer = 1) As String
'On Error GoTo ErrHandl
    If regex Is Nothing Then Set regex = CreateObject("VBScript.RegExp")
    regex.Pattern = Pattern: regex.Global = True
    'If regex.test(Text.Value) Then
        Set matches = regex.Execute(Text.Value)
        If matches.Count > 0 Then RegExpExtract = 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 If
End Function
il va de soi que le message est la juste pour la demo ;)
 
Dernière édition:

laurent950

XLDnaute Accro
Ha Ha HA ont peux dire que toi au moins tu Pat-TaugePas hi hi hi il ne faut quand même pas RexZaGéré hi hi hi... tu vas tous les mettres sur Orbite à la vitesse ou tu résouds toutes ces égnigne ha ha ha :p :p
 

Amilo

XLDnaute Accro
Re,

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

Bonne soirée à tous
 
Dernière édition:

patricktoulon

XLDnaute Barbatruc
ho je n'ai rien résolu du tout
comme je l'ai dis je reprends le code d'Amilo
  1. je vire sa gestion d'erreur qui est un non sens selon moi
  2. je créé le regex au premier calculate si il existe pas
  3. je vire le regex.test
  4. le if matches.count convient tres bien
  5. il est détruit après que la formule de la dernière ligne ai fait son boulot
  6. c'est une première pour moi
  7. j'avais jamais pensé a un object temporaire pour une fonction utilisée dans une formule et détruit au dernier calculate
 

patricktoulon

XLDnaute Barbatruc
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 :p :p :p :p :p
 

Staple1600

XLDnaute Barbatruc
Re

Apparemment la cape d'invisibilité est retombée sur mes épaules
:rolleyes:
(cf message#6 et #9)
 
Dernière édition:

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
 

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