Nombre decimal non pris en compte?

Version imprimable

bonjour je dispose du code suivant :

Code:

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:

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

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:

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

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:

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

20/03/2013, 10h59
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.
20/03/2013, 11h26
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:

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

Une autre proposition

Code:

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