Pregunta

Estoy trabajando con alguna entrada que está en las formas posibles

$1,200
20 cents/ inch
$10

¿Hay alguna forma de analizar estos números en VB? ¿También imprimiendo estos números?

EDITAR: Las expresiones regulares serían geniales.

EDITAR: VB 6 en particular

¿Fue útil?

Solución

Ehh ... Suponiendo que todo lo que quieres son los dígitos, usaría una Expresión regular para simplemente reemplazar cualquier no dígito con " " ;.

Necesitaría hacer referencia a las expresiones regulares de VBScript de Microsoft en su proyecto. Entonces digamos que su texto estaba en una variable llamada strTest. Aquí hay algunos códigos no probados:

Dim oRE As Object
Set oRE = New VBScript_RegExp.RegExp
oRe.Pattern = "\D"
strTest = oRE.Replace(strTest, "")

Otros consejos

¿Quieres decir VB6 / VBA o VB.net? En VB6 o VBA puedes hacer CLng () O CDec () dependiendo del tipo de número que desee. Se ocuparán del signo de dólar inicial y las comas muy bien. Para lidiar con los 20 centavos por pulgada, probablemente deberías hacer algo como CLng (dividido (" 20 centavos / pulgada " ;, " ") (0)) Estas funciones arrojan un error de conversión de tipo si no se pueden convertir. Puedes atrapar eso e intentar convertirlo de otra manera si fallan.

También hay una función llamada Val que devuelve la parte numérica. No genera errores de conversión de tipo como CDec. Pero tampoco maneja ninguna entrada no numérica. Le da el valor decimal de los dígitos en una cadena siempre que comience con un dígito. Ignora cualquier carácter final.

¡A veces solo se necesita fuerza bruta!

Aquí hay una rutina que toma una cadena con números y devuelve un número manejado adecuadamente con fracciones, sufijos M o B y más. Puede modificar i para manejar cualquier condición especial o álgebra de texto (millas / hora, centavos / pulgada, etc.)

Esto se toma de una de nuestras aplicaciones de producción, por lo tanto, los números de línea que usamos en nuestro controlador de errores (ERHandler), así como la rutina de salida estándar.

Function GetNumberFromString(s As String) As Currency
12800 Const ProcID = "GetNumberFromString"
12810 Dim c                                   As String
12820 Dim d                                   As Integer
12830 Dim Denominator                         As Double ' currency only handles 4 places
12840 Dim HaveDec                             As Boolean
12850 Dim HaveSlash                           As Boolean
12860 Dim HaveSpace                           As Boolean
12870 Dim i                                   As Integer
12880 Dim LenV                                As Integer
12890 Dim NegMult                             As Integer
12900 Dim Numerator                           As Currency
12910 Dim TempVal                             As Currency
12920 Dim v                                   As String

      'Provides the functionality of VAL, but handles commas, fractions
      ' also million and billion

12930 On Error GoTo ErrLbl
12940 oLog.LogProcEntry ModuleID, ProcID, "v=" & v

12950 v = Trim(s)
12960 LenV = Len(v)
12970 If LenV = 0 Then
12980     GetNumberFromString = 0
12990     GoTo ExitProc
13000 End If
13010 TempVal = 0
13020 d = 0
13030 NegMult = 1
      '
13040 For i = 1 To LenV
13050     c = Mid(v, i, 1)
13060     Select Case c
          Case "0" To "9"
13070         If HaveSpace Then
13080             If Not HaveSlash Then
13090                 Numerator = 10 * Numerator + Asc(c) - 48
13100             Else
13110                 Denominator = 10 * Denominator + Asc(c) - 48
13120             End If
13130         ElseIf Not HaveDec Then
13140             TempVal = 10 * TempVal + Asc(c) - 48
13150         Else
13160             TempVal = TempVal + ((Asc(c) - 48)) / (10 ^ d)
13170             d = d + 1
13180         End If
13190     Case ",", "<*>quot;
          ' do nothing
13200     Case "-" 'let handle negatives ns 12/20/96
13210         NegMult = -1 * NegMult
13220     Case "(" 'let handle negatives mt 6/9/99
13230         NegMult = -1 * NegMult
13240     Case "."
13250         HaveDec = True
13260         d = 1
13270     Case " "
13280         HaveSpace = True
13290         d = 1
13300     Case "/"
13310         HaveSlash = True
13320         If Not HaveSpace Then
13330             HaveSpace = True
13340             Numerator = TempVal
13350             TempVal = 0
13360         End If
13370     Case "b", "B"
13380         If UCase(Mid(v, i, 7)) = "BILLION" Then
13390             TempVal = TempVal * 1000000000#
13400             Exit For
13410         End If
13420     Case "m", "M"
13430         If UCase(Mid(v, i, 7)) = "MILLION" Then
13440             TempVal = TempVal * 1000000#
13450             Exit For
13460         End If
13470     Case Else
          ' ignore character/error
13480     End Select
13490 Next i

13500 If HaveSlash And Denominator <> 0 Then
13510     TempVal = TempVal + Numerator / Denominator
13520 End If

13530 GetNumberFromString = TempVal * NegMult

ExitProc:
13540 oLog.LogProcExit ModuleID, ProcID
13550 Exit Function

ErrLbl:
13560 Debug.Print Err.Description, Err.Number
13570 Debug.Assert False
13580 ERHandler ModuleID, ProcID
13590 Resume
End Function
Licenciado bajo: CC-BY-SA con atribución
No afiliado a StackOverflow
scroll top