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

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 :) )
 

Pièces jointes

  • Exemple désignation.xlsm
    24.2 KB · Affichages: 7
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+
 

Pièces jointes

  • Exemple désignation(1).xlsx
    12.5 KB · Affichages: 6

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:

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
 

Discussions similaires

Réponses
11
Affichages
618

Statistiques des forums

Discussions
311 720
Messages
2 081 920
Membres
101 840
dernier inscrit
SamynoT