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!
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 ✓
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?
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 ✓
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)
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 ✓
É 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.
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.