AJUDA EM FUNCAO PARA EXTRAIR NUMERO

CAETANO 27/08/2007 08:52:14
#232764

Tenho o seguinte texto em uma célula.

RETENTOR NBR 82,55X 60,32X 9,52MM NOME BASICO RETENTOR MATERIAL BORRACHA NITRILICA-NBR DUREZA 80 +/- 5 SHORE A VEDACAO PRINCIPAL SIMPLES SEM MOLA VEDACAO AUXILIAR SEM VEDACAO CONSTRUCAO ANEL DUPLO DE ACO CARBONO REVESTIMENTO PARCIAL INTERNO DIAMETRO EXTERNO 82,55 MM DIAMETRO INTERNO 60,32 MM ALTURA 9,52 MM REFERENCIA COMERCIAL GARLOCK KLOZURE-63-1654 NOTA DE ESPECIFICACAO: O MATERIAL DEVERA SER FORNECIDO EM EMBALAGEM PROPRIA A FIM DE EVITAR UMIDADE, PO E LUZ SOLAR, E DEVERA CONSTAR NA MESMA O NOME DO FABRICANTE, REFERENCIA, NUMERO DA ENCOMENDA E CODIGO CSN PARA FACILITAR SUA IDENTIFICACAO.

Preciso em uma celula colocar o calor 82,55 , em outra o valor 60,32 e em outra o valor 9,52 .Dai vou para a proxima linha , estouusando a funçãoa baixo
mas com ela eu obtenho na ultima celula o valor 9,5285
Preciso que a função rode ate encontrar "MM" no texto depois va para próxima linha.



Preciso que a função leio o texto ate "MM" , depois disso pare e va pa a a próxima linha.


Sub Extrai_numero()

Dim r As Integer
Dim last_lin As Integer
Dim e() As String
On Error Resume Next
Plan1.Activate
Application.ScreenUpdating = False
last_lin = Range("r65000").End(xlUp).Row

For r = 3 To last_lin

If Range("w" & r) = "S" And Range("Y" & r) <> "STANDARD" Then

A = Range("r" & r)



For i = 1 To Len(A)




 b = Mid(A, i, 1)

       
       
       If IsNumeric(b) = False And b <> "," And UCase(b) <> "X" Or b = " "  Then
        c = c & b
       ElseIf IsNumeric(b) = True Or b = "," Or UCase(b) = "X" Then
        d = d & b
       End If



Next i


e = Split(d, "X")

ReDim Preserve e(2)

'numeros

Plan1.Range("BA" & r) = e(0)
Plan1.Range("BB" & r) = e(1)
Plan1.Range("BC" & r) = e(2)

d = ""
e(0) = "" 'Nothing
e(1) = "" 'Nothing
e(2) = "" 'Nothing






Application.ScreenUpdating = False
Application.DisplayStatusBar = True
Application.StatusBar = r


End If

Next r



End Sub
USUARIO.EXCLUIDOS 27/08/2007 10:50:30
#232806
Cara, é mais fácil dizer o resultado do que espera...
Mas tipo, crie um projeto, coloque um textobox e um botão e tente o seguinte código, acho que é isso que você necessita:

Option Explicit

Const Texto As String = "RETENTOR NBR 82,55X 60,32X 9,52MM NOME BASICO RETENTOR MATERIAL BORRACHA NITRILICA-NBR DUREZA 80 +/- 5 SHORE A VEDACAO PRINCIPAL SIMPLES SEM MOLA VEDACAO AUXILIAR SEM VEDACAO CONSTRUCAO ANEL DUPLO DE ACO CARBONO REVESTIMENTO PARCIAL INTERNO DIAMETRO EXTERNO 82,55 MM DIAMETRO INTERNO 60,32 MM ALTURA 9,52 MM REFERENCIA COMERCIAL GARLOCK KLOZURE-63-1654 NOTA DE ESPECIFICACAO: O MATERIAL DEVERA SER FORNECIDO EM EMBALAGEM PROPRIA A FIM DE EVITAR UMIDADE, PO E LUZ SOLAR, E DEVERA CONSTAR NA MESMA O NOME DO FABRICANTE, REFERENCIA, NUMERO DA ENCOMENDA E CODIGO CSN PARA FACILITAR SUA IDENTIFICACAO."

Function GetTexto(ByVal Valor As String)
Dim Cels() As String, sAux As String, Linha As String
Dim i As Integer, j As Integer, iAux As Integer

' Quebra o texto ao encontrar "MM"
Cels = Split(Valor, "MM")

' Loop para ler todas linhas
For i = 0 To UBound(Cels)
  Linha = ""
  ' Ler cada caracter da linha
  For j = 1 To Len(Cels(i))
    ' Verifica se o digito atual é numérico (se não for, vai ao próximo)
    If IsNumeric(Mid(Cels(i), j, 1)) Then
      ' Procurar o "X" a partir do digito atual
      iAux = InStr(j, Cels(i), "X")
      ' Verifica se encontrou o "X"
      If iAux > 0 Then
        ' Pega o valor até o "X"
        sAux = Trim(Mid(Cels(i), j, iAux - j))
        ' Verifica se o valor é numerico
        If IsNumeric(sAux) Then
          ' Adiciona o valor na linha
          Linha = Linha & vbTab & sAux
          ' Pula para o digito após o "X" encontrado
          j = iAux + 1
        End If
      ' Verifica se o digito até o final também é numerico (tirando os espaços com o Trim)
      ElseIf IsNumeric(Trim(Mid(Cels(i), j))) Then
        ' Adiciona o valor na linha
        Linha = Linha & vbTab & Trim(Mid(Cels(i), j))
        ' Pula até o final, para ir à próxima linha
        j = Len(Cels(i))
      End If
    End If
  Next j
  ' Adiciona a linha no TextBox
  Text1 = Text1 & vbCrLf & Mid(Linha, 2)
Next i
End Function

Private Sub Command1_Click()
Text1 = ""
GetTexto Texto
End Sub


Qualquer dúvida poste...flw
CAETANO 28/08/2007 07:57:46
#232993
Matheus com esta função ele extrai os numeros , porem eles ficam armazenadaos em uma string apenas , preciso que cada numero seja isolado.
Assim acha o primeiro numero 10 isola , vai para o próximo , isola e assim com o terceiro tb, desta forma eu coloco os numeros em células diferentes.
Tópico encerrado , respostas não são mais permitidas
Voltar