Autres occurence

[Michou9]

Bonjour à tous
je souhaite extraire des nombres à l'intérieure de cellules
Ces nombres sont tous suivi d'un symbole par exemple "€"
Mon problème c'est qu'il y plusieurs symboles identiques
Pour ressortir le premier, nombre c'est facile
Pour le 2ème, j'y arrive aussi
Mais pour les suivants, je cale
Si je peux obtenir de l'aide ?
Merci d'avance

exemple d'une cellule :
F:\House\A-85\1\ZZ\4 machin 315€Net 330€ 333€ 344€ 385€ 122m 130m 900m 987m 2588€m @2023 TypeA 597€an
Je souhaite donc ressortir 315€ 330€ 344€ 385€ et ainsi de suite

 

[bsalv]

or comme ceci

Function Separer(s)
     Dim i, sp
     Separer = ""
     If Len(s) > 0 Then
          sp = Filter(Split(s), "€", 1, 1)
          If UBound(sp) > -1 Then
               For i = 0 To UBound(sp)
                    sp(i) = Val(sp(i))
               Next
               Separer = sp
          End If
     End If
End Function

PS. comment faut-il traiter des points ou des virgules ?

 

[Michou9]

C'est bien ce que je voulais faire
J'ai donc incorporer cette nouvelle fonction
Seulement cela provoquait la même erreur que précédemment
J'ai donc rajouter :
On Error Resume Next

Comme j'ai utiliser (par négligence) le même symbole "m" pour 2 types de données et que je ne peux pas revenir en arrière
J'ai voulu limiter les nombres extrait à 300
J'ai donc aussi rajouter :
If (T2(UBound(T2))) > 300 Then Separem = ""

Soit:
Function Separem(C$, N%)
Dim T, T2
T = Split(C, "m ")
If N > UBound(T) Then Separem = "": Exit Function
T2 = Split(T(N - 1), " ")
On Error Resume Next
Separem = CDbl(T2(UBound(T2)))
If Right(T2(UBound(T2)), 1) = "€" Then Separem = ""
If (T2(UBound(T2))) > 300 Then Separem = ""
End Function

 

[Michou9]

Bonjour bsalv
Merci pour ta solution
Je ne l'ai pas encore testée
Je vais bien sûr le faire et je reviendrai donner les résultats

 

[Michou9]

Bonjour sylvanu
Comme je l'ai dit hier soir, j'ai donc limiter l'extraction des valeurs "m" à 300
A présent je souhaite extraire les valeurs de plus de 300 dans d'autres colonnes
J'ai donc utiliser la même fonction en remplaçant If (T2(UBound(T2))) > 300 Then Separem = "" par If (T2(UBound(T2))) < 300 Then Separem = ""
Cela fonctionne très bien, bien sûr, mais cela pose un problème
Les nombres de plus de 300 n'apparaissent jamais dans la première occurrence
Je commence donc la fonction à partir de la 2ème occurrence
Mais la première occurrence de plus de 300 ne peut apparaitre qu'a partir de la 3ème occurrence , 4ème ou plus
Du coup dans mes premières colonnes je me retrouve avec des cellules vides
Ce qui serait parfait c'est que si la 2ème occurrence ne contient pas de nombre supérieure à 300, elle passe directement à l'occurrence suivante
ce qui permettrait donc d'afficher la valeur dans la 1ère colonne au lieu de la 3ème ou plus colonne

​

 

[patricktoulon]

Bonjour à tous
que ne faut il pas faire pour quelques euros
alors la chose et simple
récupérer toutes les occurrences numériques suivies de "€"
voici ma fonction qui suit un raisonnement très simple
le raisonnement: récupérer les valeurs suivies du symbole ou caractère demandé
en splitant par les espace et testant les items VAL + instr(le char demandé) c'est réglé on récupère le val+le char
terminé
et pour le coup on l'utilisera en matriciel ou étirable unitairement

Function GetSuiteNumerique(v As String, Char As String, Optional index As Long = 0)
    Dim T, i&, res$: T = Split(v, " ")
    If InStr(v, Char) = 0 Then GetSuiteNumerique = "": Exit Function
    For i = LBound(T) To UBound(T)
        If Val(T(i)) > 0 And InStr(T(i), Char) > 0 Then res = res & " " & Val(T(i)) & Char
    Next
    T = Split(Trim(res), " ")
    If index > 0 Then GetSuiteNumerique = T(index - 1) Else GetSuiteNumerique = T
End Function

exemple formule:
en A1 j'ai la chaine
en B1 je met =GetSuiteNumerique($A$1;"€";colonne(A1)) --->étirable horizontalement
ou
en B1 je met =GetSuiteNumerique($A$1;"€";ligne(A1)) --->étirable verticalement
ou
en b1:F1 je met =GetSuiteNumerique(A1;"€") --->et je valide en matriciel pour les version Excel inférieur a 2019

démo de la fonction dans la vidéo

Pour afficher ce contenu, nous aurons besoin de votre consentement pour définir des cookies tiers.
Pour plus d'informations, consultez notre page sur les cookies.

Accepter les cookies de tiers

Patrick

 

[patricktoulon]

re
et au cas ou(pour blinder le truc ) au cas ou ;il n'y aurait pas d'espaces dans la chaine de départ
et bien on replace au préalable tout caractère non numérique et différent du char
résultat kif kif

Function GetSuiteNumerique2(v As String, Char As String, Optional index As Long = 0)
    Dim T, i&, res$: T = Split(v, " ")
    If InStr(v, Char) = 0 Then GetSuiteNumerique2 = "": Exit Function
    For i = 1 To Len(v)
        If Not IsNumeric(Mid(v, i, 1)) And Not Mid(v, i, 1) = "€" Then Mid(v, i, 1) = " "
    Next
    T = Split(v, " ")
    For i = LBound(T) To UBound(T)
        If Val(T(i)) > 0 And InStr(T(i), Char) > 0 Then res = res & " " & Val(T(i)) & Char
    Next
    T = Split(Trim(res), " ")
    If index > 0 Then GetSuiteNumerique2 = T(index - 1) Else GetSuiteNumerique2 = T
End Function

Terminé les formule c'est les même en rajoutant 2 au non de la fonction
Patrick

 

[bsalv]

toutes ces explications ... "Small is beautiful" (Schumacher)

sp = Filter(Split(s), "€", 1, 1)

 

[job75]

Bonjour le forum,

Pas bien compris ce que Michou9 veut obtenir mais voici une solution avec les expressions régulières :

Function ExtraitNombres(texte$, mini&, occurrence%)
    Dim regEx As Object, matches As Object, m As Object, n%
    Set regEx = CreateObject("VBScript.RegExp")
    regEx.Pattern = "\d+"   'un ou plusieurs chiffres
    regEx.Global = True
    Set matches = regEx.Execute(texte)
    ExtraitNombres = ""
    For Each m In matches
        If m >= mini Then n = n + 1: If n = occurrence Then ExtraitNombres = m: Exit Function
    Next m
End Function

La fonction récupère les nombres au moins égaux à mini.

A+

 

[nullosse]

Salut,
pour Excel 2007, on peut utiliser le complément de Jurassic Pork qui se trouve ici
Dans ce compléments il y a des fonctions de formule Excel en particulier la fonction Regexextractjp qui permet d'extraire des chaines à partir d'une expression régulière. Le résultat peut s'étendre sur plusieurs cellules en vertical ou en horizontal.
Par exemple pour réaliser ce qui est demandé dans le classeur du post #19 , la formule est :

=REGEXEXTRACTJP(A5;"\b([3-9]\d{2}m|[1-9]\d{3,}m)";2)

voici ce que cela donne dans un Excel 2007 :

Nullosse

 

[mapomme]

Bonjour @Michou9🙂, à toutes et tous😉,

Comme j'avais un peu de temps à tuer avant le repas dominical, j'ai tenté une autre approche sans split (pour le fun 🤪) et avec un nombre quelconque de séparateurs (au moins un séparateur). On a pris l'hypothèse que les nombres sont des entiers. On ne retient que les nombres de la forme: espace suivi d'une suite de chiffres suivis d'un des séparateurs. Une occurrence en tête du texte (donc sans espace devant) est bien évidemment aussi prise en compte. La casse du séparateur n'est pas prise en compte.

Exemple : =Montant ( A1 ; 3 ; "€" ; "m" ; "$" ) On extrait le 3ème nombre entier du texte de la cellule A1 avec comme séparateur "€" ou "m" ou bien "$").

Le code est légèrement commenté :

Function Montant(ByVal Texte$, ByVal Nieme&, Separ$, ParamArray Sep())
Dim x, i&, c$, n&, m&, j&
   Montant = "": Texte = LCase(Texte)
   ' remplacement de chaque séparateur par le caractère improbable chr(1)
   Texte = Replace(Texte, LCase(Separ), Chr(1)): For Each x In Sep: Texte = Replace(Texte, LCase(x), Chr(1)): Next
   ' Initialisation de variables de la boucle de recherche
   Texte = " " & Texte: i = 2: m = 0
   ' Boucle de recherche sur chaque caractère de texte
   Do
      c = Mid(Texte, i, 1)    ' caractère i de Texte
      If c = Chr(1) Then      ' si c correspond à un séparateur
         j = i - 1            ' le début du supposé nombre est i-1 (juste avant le séparateur)
         ' boucle pour rechercher le premier caractère j avant i qui n'est pas un chiffre
         Do While Mid(Texte, j, 1) Like "#": j = j - 1: m = m + 1: Loop
         ' si le caractère  j est un espace et si le nombre de chiffre avant i est au moins 1
         ' alors on a une occurrence de plus à retenir et on augmente le nombre m d'occurrences trouvées
         If Mid(Texte, j, 1) = " " And m > 1 Then n = n + 1
         ' si m correspond à Nieme, on a trouvé l'occurence recherchée et on la renvoie
         If n = Nieme Then Montant = CLng(Right(Left(Texte, i - 1), m)): Exit Function
      End If
      ' on passe au caractère i suivant et m est remis à 0
      m = 0: i = i + 1
   Loop Until i > Len(Texte)  ' fin de la boucle (tous les caractères i ont été parcourus)
End Function

 

[job75]

L'inconvénient de la fonction VBA du post #23 c'est que l'objet regEx est recréé à chaque fois.

Du coup les 45 formules se recalculent en 3,5 secondes, c'est bien long.

Avec cette macro le calcul se fait en 0,25 seconde, c'est plus acceptable :

Private Sub Worksheet_selectionChange(ByVal Target As Range)
Dim regEx As Object, c As Range, a(), n%, matches As Object, m As Object
Set regEx = CreateObject("VBScript.RegExp")
regEx.Pattern = "\d+"   'un ou plusieurs chiffres
regEx.Global = True
For Each c In [A1].CurrentRegion.Columns(1).Cells
    Erase a: n = 0
    Set matches = regEx.Execute(c)
    For Each m In matches
        If m >= 100 Then ReDim Preserve a(n): a(n) = m: n = n + 1
    Next m
    If n Then c(1, 2).Resize(, n) = a
    c(1, 2).Offset(, n).Resize(, Columns.Count - n - 1).ClearContents 'RAZ à droite
Next c
End Sub

 

[bsalv]

@job75, j'ai l'idée que ce split&filter est plus performant, vitesse = 1.5 à 2 fois plus vite, mais peut-être dû au fait qu'on ignore les chiffres non-monetaires.

 

[job75]

En général les expressions régulières ne sont pas particulièrement rapides.

 

[nullosse]

Salut,
les expressions régulières dans les formules sont assez performantes . Pour tester la performance : recopier les 5 cellules avec les données Texte du classeur du post #19 dans un nouveau classeur à partir de A1.Recopier ces 5 lignes sur 100 lignes. Pour ceux qui possèdent Excel365 entrez cette formule (ou l'équivalent en français) en C1 :

=REGEXEXTRACT(A1,"\b([3-9]\d{2}(m|€)|[1-9]\d{3,}(m|€))",1)

Cette formule extrait toutes les parties qui contiennent un nombre suivi soit d'un m ou soit d'un € et qui sont supérieurs à 299
Tirer la formule jusqu'à la ligne 100.
Comme je n'ai pas Excel365, j'ai fait l'essai sur Excel 365 onLine qui est en anglais :

L'avantage de REGEXEXTRACT c'est que le résultat s'étend automatiquement sur les cellules adjacentes si besoin.

Pour calculer le temps de calcul , utiliser une macro du style :

Sub CalcFull()
Dim bm As New cBenchmark
bm.Start
Application.CalculateFull
bm.TrackByName "CalculateFull"
End Sub

Comme on ne peut pas faire de macro sur Excel OnLine, j'ai fait le test avec la fonction REGEXEXTRACTJP qui est équivalente à REGEXEXTRACT mais qui doit être plus lente car utilise un complément c#.

=REGEXEXTRACTJP(A1;"\b([3-9]\d{2}(m|€)|[1-9]\d{3,}(m|€))";2)

Pour les 100 lignes avec formule , j'obtiens 17 ms
En VBA les expressions régulières ça doit être 50× à 150× plus lent
Nullosse