Como encontrar um número após um caractere no VBA

Question

Como posso encontrar um valor numérico depois de um caractere na mesma célula.

Por exemplo: Encontre o número 01 após J* . Eu tenho algumas linhas e em cada linha tenho valor como J*01 ou J*08 .

Atualmente, estou tentando separar caracteres e números usando o VBA InStr function:

 Sub zz()
   Dim ii As Long, z As Integer, xlastrow As Long
   Dim yy As String
   xlastrow = Worksheets("Sheet1").UsedRange.Rows.Count
     For ii = 1 To xlastrow
       yy = "J*"
       z = 1         
       If IsNumeric(Worksheets("Sheet1").Range("B" & ii)) Then       
         'This line is separating numbers after J* character and pasting to sheet2
         Seprate.Find.Range("B" & ii, yy).Value = Worksheet("Sheet2").Range("A" & z)
       End If
       z = z + 1
     Next ii    
 End Sub

    

Answer 1

Aqui está outra função definida pelo usuário que retornará todos os dígitos após uma determinada string (prefixo). Nos argumentos, você especifica a string a ser processada e o prefixo a ser usado. Você também pode especificar se o prefixo deve diferenciar maiúsculas de minúsculas. O padrão é que não seja sensível a maiúsculas e minúsculas, mas isso é facilmente alterado.

O UDF usa expressões regulares para processar o texto. Primeiro, removemos tudo até e incluindo o prefixo. Em seguida, removemos todos os não dígitos no restante.

===================================

Option Explicit
Function DigitsAfter(sInput, sPrefix, Optional MatchCase As Boolean = False) As String
    Dim re As Object
    Dim S As String
    Dim sPatPrefix As String
    Const sPat As String = "\D"

'Intialize Regex engine
Set re = CreateObject("vbscript.regexp")
With re
    .Global = True
    .ignorecase = Not MatchCase
End With

'Generate the digit prefix
re.Pattern = "(.)"
sPatPrefix = ".*" & re.Replace(sPrefix, "\")

'Remove characters up to and including the prefix
re.Pattern = sPatPrefix
    If re.test(sInput) = False Then

'Exit if prefix not in string
        DigitsAfter = "Digit Prefix not in String"
        Exit Function

'now remove all the non-digits that are left
    Else
        S = re.Replace(sInput, "")
        re.Pattern = sPat
        DigitsAfter = re.Replace(S, "")
    End If
End Function

=====================================

Aqui está uma pequena rotina mostrando como ele pode ser usado em uma macro maior:

======================================

Option Explicit
Sub TestDigitFunction()
    Const S As String = "abc12x97J*24AAA123"

    MsgBox S & vbLf & DigitsAfter(S, "J*")

End Sub

======================================

    

Answer 2

Isso resolve sua pergunta em vez de seu código de amostra. Se você tem uma string como:

q1w2e3r4asJ * 66bvft654

e deseja extrair os dois dígitos após J * e, em seguida, testar esta pequena UDF

Public Function RetDigits(sIN As String) As String
    Dim lookFor As String, v As String
    lookFor = "J*"
    RetDigits = ""
    If InStr(sIN, lookFor) = 0 Then Exit Function
    ary = Split(sIN, lookFor)
    If Len(ary(1)) < 2 Then Exit Function
    RetDigits = Left(ary(1), 2)
End Function

Por exemplo:

EDIT#1:

Aquiestáumaversãoqueretornarámaisde2dígitos:

PublicFunctionRetDigits(sINAsString)AsStringDimlookForAsString,vAsString,aryDimiAsLong,CHAsStringlookFor="J*"
    RetDigits = ""
    If InStr(sIN, lookFor) = 0 Then Exit Function
    ary = Split(sIN, lookFor)
    If Len(ary(1)) < 2 Then Exit Function

    For i = 1 To Len(ary(1))
        CH = Mid(ary(1), i, 1)
        If IsNumeric(CH) Then
            RetDigits = RetDigits & CH
        End If
    Next i
End Function

e aqui está uma rotina de testes:

Sub main()
    Dim st As String, out As String
    st = "hfskfhjsdfshjJ*123456"
    out = RetDigits(st)
    MsgBox out
End Sub

    

Answer 3

Para encontrar o valor exato de dois dígitos após " J* ", você não precisa do VBA. Se a string estiver em A1, use: =VALUE(MID(A1;SEARCH("J*";A1)+2;2)) . A função SEARCH procura " J* ". MID recebe os próximos dois caracteres e VALUE converte esses valores em um valor.