Discussion :

[yannoch123]

bonjour je dispose du code suivant :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
Function estChif(ByVal s As String) As Boolean
'Renvoie vrai si le caractère s est un chiffre.
  estChif = Asc("0") <= Asc(s) And Asc(s) <= Asc("9")
End Function
 
Function extractionNb(ByVal s As String, ByVal d As Integer) As String
'Renvoie le premier nombre contenu dans la chaîne de caractères s,
'à partir de la position d ; renvoie -1 s'il n'y en a pas.
  Dim n As Integer, i As Integer, p As String
  n = Len(s): i = d
  Do
    If i > n Then
      extractionNb = -1: Exit Function
    ElseIf estChif(Mid(s, i, 1)) Then
      Exit Do
    Else
      i = i + 1
    End If
  Loop
  p = Mid(s, i, 1): i = i + 1
  Do
    If i > n Then
      extractionNb = p: Exit Function
    ElseIf estChif(Mid(s, i, 1)) Then
      p = p & Mid(s, i, 1): i = i + 1
    Else
      extractionNb = p: Exit Function
    End If
  Loop
End Function

Malheureusement lorsque j utilise une fonction test je remarque que mon code ne prend pas en compte les nombres decimaux

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
Sub TestExtraction()
Dim code As String, d As Integer
code = "10y10y 200wc A300.12 vs 500"
MsgBox ("le nombre cherche vaut : " & extractionNb(code, 15) & Chr(10))
End Sub

ce test par exemple ne me renvoie que la valeur 300
Comment faire pour tenir compte des nombres decimaux a , et a . ? merci de votre aide

[rjamin]

Bonjour,
Le test estChif du point décimal ou de la virgule renvoie Faux ce qui provoque la sortie de la fonction dès la rencontre d'un de ces deux éléments.
Il faudrait mettre un test sur ce fait et continuer la lecture des caractères au delà des caractères . et ,

Re,
Voilà une suggestion

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
Function extractionNb(ByVal s As String, ByVal d As Integer) As String
'Renvoie le premier nombre contenu dans la chaîne de caractères s,
'à partir de la position d ; renvoie -1 s'il n'y en a pas.
  Dim n As Integer, i As Integer, p As String
  n = Len(s): i = d
  Do
    If i > n Then
      extractionNb = -1: Exit Function
    ElseIf estChif(Mid(s, i, 1)) Then
      Exit Do
    Else
      i = i + 1
    End If
  Loop
  p = Mid(s, i, 1): i = i + 1
  Do
    If i > n Then
      extractionNb = p: Exit Function
    ElseIf estChif(Mid(s, i, 1)) Then
      p = p & Mid(s, i, 1): i = i + 1
      If Mid(s, i, 1) = "." Or Mid(s, i, 1) = "," Then
        p = p & Mid(s, i, 1): i = i + 1
      End If    Else
      extractionNb = p: Exit Function
    End If
  Loop
End Function

[yannoch123]

merci rj de ton aide , finalement j ai code une autre fonction plus simple et plus en accord avec ce que je cherche a faire toutefois j ai utilise la fonction replace mais ca ne marche qu avec les . pas les virgukes (pourtant je comprend ma fonction replace devrait remplacer les , par des pts . ) je vous montre le code

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
Function LeftNum(str As String) As Double
    Dim n As Integer, i As Integer, ch As String, str0 As String, str1 As String, bln As Boolean
    str0 = Replace(str, ",", ".")
    n = Len(str)
    For i = 1 To n
        ch = Mid(str, i, 1)
        If IsNumeric(ch) Or ch = "." Then
            str1 = str1 + ch
            bln = True
 
        ElseIf bln = True Then
            Exit For
        End If
    Next i
    LeftNum = CDbl(str1)
End Function

[rjamin]

Re,
Si je comprends bien la fonction va ramener 10 puisqu'elle cherche une valeur numérique à partir du 1er caractère au lieu du 15ème.
Pour le remplacement si une virgule existe dans la chaîne elle sera remplacée par un .
Seulement CDbl ne traite la chaîne entierrement que si elle contient une virgule apparement.

[yannoch123]

exactement elle va me ramener 10 en fait je vais l utiliser en sectionnant la chaine de caractere en fonction de mes besoins , toutefois j ai 2 petits problemes pour pouvoir commencer mon projet .
Le 1er c que lorsque dans mon code j ai un nombre a virgules par exmple code : "101,52 ws" ca va me renvoyer 101 alors que pour "101.52 ws" ca me renvoie bien ce que je chercher a savoir 101.52
Pour le 2eme je vous explique , ma fonction leftnum a ete utilise de la sorte

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
Function Findarobas (ode As String) As Double
 Dim pos As Integer
   pos = InStr(code, "@")
 FindLast = LeftNum(Mid(code, pos))

dc pour le code suivant code = "10y10y 200wc @ 300.23 vs 500"
ca va me renvoyer 300.23 (c bien ce que je cherchais )
Toutefois j'aimerais savoir comment retrouver ce meme chiffre mais a partir de la position de "vs" (si possible en utilisant Leftnum )?

AH c bon en fait j ai fait une petite erreur d inattention je n ai pas remplacer dans mon code de leftnum str par str0 dc forcement le replace n a pas ete pris en compte

[mercatog]

Une autre proposition

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
Private Function ExtrNb(ByVal Str As String, Optional ByVal d As Integer = 1) As Double
Dim i As Integer
 
If d < Len(Str) Then
    Str = Mid(Str, d)
    For i = 1 To Len(Str)
        If IsNumeric(Mid(Str, i, 1)) Then Exit For
    Next i
    If i < Len(Str) Then ExtrNb = Val(Mid(Str, i))
End If
End Function