Função para separar...
 
Notifications
Clear all

Função para separar uma String

8 Posts
2 Usuários
0 Reactions
1,721 Visualizações
(@gilbertjrs)
Posts: 77
Trusted Member
Topic starter
 

Pessoal, boa noite.

Estou tentando implementar uma função que eu passe uma String para ela e um caracter referencia para separação e ela me retorne uma Array contendo os itens separados e a quantidade de itens. exemplo:

String original = "A casa vermelha"
caracter de referência = " "

retorno desejado:
a(0) = "A"
a(1) = "casa"
a(2) = "vermelha"
quant = 3

Tentei adaptar este código do site http://www.tomasvasquez.com.br/blog/tag/contar-caracter-string-vba

Public Function ContaCaracteresNaString(ByVal texto As String, ByVal caracter As String) As Long
     Dim x As Variant
     x = Split(texto, caracter)
     ContaCaracteresNaString = UBound(x)
End Function
 
Public Sub Teste()
     MsgBox ContaCaracteresNaString("janeiro|fevereiro|março|abril|", "|")
End Sub

porém, ainda não consegui.

Alguém me da uma luz, please!

 
Postado : 25/04/2017 5:11 pm
Syrax
(@syrax)
Posts: 160
Estimable Member
 

Fiz uma função há um tempo atrás chamada Gettok
essa função existe em outras linguagens

Function Gettok(txt As String, crt As String, nm As Integer)
Dim arr() As String
arr = Split(txt, crt)
If nm > 0 Then
Gettok = arr(nm - 1)
ElseIf nm = 0 Then
Gettok = UBound(arr) + 1
End If
End Function

exemplo

Modo de usar:

=Gettok(texto ou referência;"caractere separador";referência)

=Gettok(teste testando;" ";1) ' vai retornar "teste" pois é a primeira referência separada por espaço
=Gettok(teste testando;" ";2) ' vai retornar "testando" pois é a segunda referência separada por espaço

=Gettok(teste.testando;".";1) ' vai retornar "teste"

=Gettok(teste.testando;".";0) ' vai retornar o número de todas as referências, nesse caso 2

Se essa resposta te ajudou e resolveu o seu problema, clique no "joinha" ao lado de citar, e não esqueça de colocar o tópico como resolvido, clicando no ✓

 
Postado : 25/04/2017 5:40 pm
(@gilbertjrs)
Posts: 77
Trusted Member
Topic starter
 

Eu tenho uma macro lá na empresa que busca informações de um relatório PDF que foi colado no Excel.
Quem desenvolveu utilizou uma função que fica extraindo bloco por bloco e colocando numa array.
Esta array atualmente é uma variável global e como estou corrigindo alguns bug estou querendo eliminar o uso de variáveis globais.
Vi este código utilizando a função SPLIT e verifiquei na inspeção de variáveis que a array x contem todas as partes da String original já separadas, pensei em retornar esta array x porém, não consegui.

O desenvolvedor anterior utilizou o seguinte código com a array global lsep()

Function lsepara1(str, str2 As String)
    For i = 0 To 100
        lsep(i) = ""
    Next
    sa = str
    na = 0
    i = InStr(sa, str2)
    isep = 0
    While i > 0
        s1 = Mid(sa, 1, i - 1)
        lsep(na) = s1
        na = na + 1
        sa = Mid(sa, i + 1, 1000)
        i = InStr(sa, str2)
        isep = isep + 1
    Wend
   
    lsep(na) = sa
   
    lsepara1 = isep
 
End Function

Porém do jeito que você me sugeriu eu teria que mudar uma centena de macros (de Excel e de Catia V5) que atualmente utiliza esta função, por isto, necessito que retorne a array completa.

Tem alguma maneira de aproveitando esta função Split retornar todas as posições da array?

 
Postado : 25/04/2017 6:09 pm
Syrax
(@syrax)
Posts: 160
Estimable Member
 

Sempre há um porém ou uma variável que nunca é dita na pergunta original, explicar toda a questão facilita o trabalho, já que o projeto está na sua mente e não na nossa

a respeito da função que você mostrou, o que deve conter em str e str2? vi muitas coisas redundantes nessa função

a respeito do split, você deve informar qual o caractere que separa esse texto, por acaso é o espaço?

supondo que o caracter que separa seja o espaço

Sub teste()
Dim x() As String, b As String
b = "teste testando apenas um teste"
x = Split(b, " ")
For i = 0 To UBound(x) ' ubound verifica qual a última posição ocupada dentro da array
MsgBox x(i) ' retorna cada posição
Next i
End Sub

se você precisa que retorne tudo em uma linha

Sub teste1()
Dim x() As String, b As String
b = "teste testando apenas um teste"
x = Split(b, " ")
For i = 0 To UBound(x)
a = a + " " + x(i) ' faz uma variável com os valores da array
Next i
MsgBox a ' retorna todos os valores em uma linha
End Sub

Mais do que isso, somente você disponibilizando todo o arquivo, pois se não for isso, não entendi

Se essa resposta te ajudou e resolveu o seu problema, clique no "joinha" ao lado de citar, e não esqueça de colocar o tópico como resolvido, clicando no ✓

 
Postado : 25/04/2017 6:31 pm
(@gilbertjrs)
Posts: 77
Trusted Member
Topic starter
 

Cara, são arquivos lá da empresa e não tem como sair de lá.

Uma questão: Você fez tudo na macro (Sub) e necessito que seja uma function retornando todos as posições.
Vou tentar rascunhar a idéia através dos códigos abaixo:

Sub Main(){
ultLinha = ThisWorkbook.Sheets("referencias").Range("A1").End(xlDown).Row
For i = 1 To ultLinha
info = ThisWorkbook.Sheets("referencias").Range("A" & i).Value
Call separa(info," ")

For j = 0 To fimArray
' Aqui farei as comparações dos itens  Array(j)
Next
Next 
End Sub
Function separa(ByVal srt1 As String, ByVal str2 As Sring) Array() As String, fimArray As Integer
'Aqui a separação que não estou conseguindo implementar
return Array()
return fimArray
End Function

Posi desta forma eu substituiria apenas as funções de separação e suas chamada e o resto das linha (onde existem as comparações) de centenas de arquivos legados não seria alterada.
(Não tenho tempo disponível para editar todas as macros que um ex-funcionário deixou)

 
Postado : 25/04/2017 7:38 pm
Syrax
(@syrax)
Posts: 160
Estimable Member
 

Veja se isso te ajuda

Sub Main()
Dim info() As String ' cria uma array 
ultlinha = ThisWorkbook.Sheets("referencias").Range("A1").End(xlDown).Row
For i = 1 To ultlinha
ReDim Preserve info(0 To ultlinha - 1) ' redimensiona a array, fazendo com que ela tenha a mesma quantidade de espaço que as linhas
info(i - 1) = ThisWorkbook.Sheets("referencias").Range("A" & i).Value ' atribui valores a array
Next i

For j = 0 To UBound(info) ' verifica qual a ultima posição da array
' Aqui farei as comparações dos itens  Array(j) - aqui você pode fazer a sua comparação
Next

End Sub

Até onde sei, mesmo fazendo uma function, ela sempre retorna o último valor correspondente
mesmo voce usando um for loop em uma function, ela não volta para a macro que a chamou e retorna os valores um por um
no exemplo acima, criei uma array com as informações, é simples e não precisa modificar tanto o código
Agora que entendi, voce não precisa fazer uma comparação usando um for loop para uma array
se você precisa achar um valor dentro de uma array, pode usar application.match

Sub Main()
Dim info() As String ' cria uma array 
ultlinha = ThisWorkbook.Sheets("referencias").Range("A1").End(xlDown).Row
For i = 1 To ultlinha
ReDim Preserve info(0 To ultlinha - 1) ' redimensiona a array, fazendo com que ela tenha a mesma quantidade de espaço que as linhas
info(i - 1) = ThisWorkbook.Sheets("referencias").Range("A" & i).Value ' atribui valores a array
Next i

c = IsError(Application.Match("teste", info, 0)) ' verifica se "teste" está na array
if c = false then
' código para sim
else
' código para não
end if

End Sub

Se você não aceitar essa resposta, talvez outra pessoa possa te ajudar

Qualquer dúvida, pergunte

Se essa resposta te ajudou e resolveu o seu problema, clique no "joinha" ao lado de citar, e não esqueça de colocar o tópico como resolvido, clicando no ✓

 
Postado : 25/04/2017 8:23 pm
(@gilbertjrs)
Posts: 77
Trusted Member
Topic starter
 

É um pouco mais complicado, não tem um texto específico para procurar dentro da array e varia de caso a caso porém, todas utlizam esta função que separa strings baseadas num critério e coloca o resultado num array (atualmente os arrays são variáveis globais).

Tem uma macro que analisa um relatório que no formato original (em PDF) possui um cabeçalho e que dependendo da condição os valores que se deseja buscar estão após o 3º, 5º e 6º espaço e em outras condições os mesmos valores estão após o 2º, 5º e 7º espaços.

Em outra macro ela analisa linhas descritivas de peças em software de CAD, e obtem as informações por critérios de espaços (neste caso o VBA não roda num Excel mas sim dentro do próprio softaware de CAD)

Outras vezes, o critério de separação é um ponto e virgula como por exemplo a comparação de dados com arquivos .csv

E são centenas de arquivos legados e todas utilizam esta função ou similares a esta

Function lsepara1(str, str2 As String)
    For i = 0 To 100
        lsep(i) = ""
    Next
    sa = str
    na = 0
    i = InStr(sa, str2)
    isep = 0
    While i > 0
        s1 = Mid(sa, 1, i - 1)
        lsep(na) = s1
        na = na + 1
        sa = Mid(sa, i + 1, 1000)
        i = InStr(sa, str2)
        isep = isep + 1
    Wend
   
    lsep(na) = sa
   
    lsepara1 = isep
 
End Function

Quero apenas uma alternativa para substituir esta função e que não utilize variáveis globais como ela.

 
Postado : 25/04/2017 9:17 pm
(@gilbertjrs)
Posts: 77
Trusted Member
Topic starter
 

Syrax, boa tarde.

Fiz uma adaptação de uma planilha que me foi fornecida como resposta no forum https://gurudoexcel.com/forum/viewtopic.php?f=12&t=4568&p=22594#p22594 e, mesclei com o turorial do site http://www.geeksengine.com/article/vba-function-multiple-values2.html, resolveu meu problema.

O código final ficou assim:

 Public Function separar(ByVal str1 As String, ByVal str2 As String) As Variant
    Dim WrdArray() As String
    WrdArray() = Split(str1, str2)
    separar = WrdArray
End Function
Sub principal()
    Dim arr As Variant
    linhaREF = 1
    While Not IsEmpty(ThisWorkbook.Worksheets("Folha3").Range("A" & linhaREF))
    
        Info = ThisWorkbook.Worksheets("Folha3").Range("A" & linhaREF).Value
        
        arr = separar(Info, " ")
        
        ' Daqui pra baixo posso realizar as comparações do código pré-existente
        For i = 0 To UBound(arr)
            Debug.Print arr(i)
        Next
        
        Debug.Print ""
        
        linhaREF = linhaREF + 1
    Wend
    
End Sub

De qualquer forma, grato pelas orientações dadas.

 
Postado : 26/04/2017 10:18 am