Ajuda em sub rotina....

Question

   Fala galera do msdn, estou com o seguinte cenário: tenho uma célula onde a mesma será preechida com várias palavras seguidas por vírgula, exemplo: teste1, teste2, teste3 .

   Estou tentando fazer um subrotina que pegará as palavras deste célula e colocará em células de uma coluna, exmplo:   teste1

                                      teste2

                                      teste3

                                      teste4

 

  Já consegui fazer com a ferramenta "texto para colunas" , mas gostaria de fazer uma rotina, para ficar mais automatizado.

 

Valeu

     

Answer 1

Boa noite.

Você pode tentar o seguinte código:

Public Sub Separa(rngOrigem As Range, rngDestino As Range)
  Dim aTokens As Variant
  Dim lngIndice As Long
  Dim intOffset As Integer
  If (Not IsEmpty(rngOrigem.Value)) Then
    aTokens = Split(CStr(rngOrigem.Value), ",")
    If (Not IsEmpty(aTokens)) Then
      intOffset = 0
      For lngIndice = LBound(aTokens) To UBound(aTokens)
        rngDestino.Offset(intOffset, 0).Value = aTokens(lngIndice)
        intOffset = intOffset + 1
      Next lngIndice
    End If
  End If
End Sub

Para chamar este procedimento imagine o seguinte cenário:

1. Na célula A1 você tem o texto separado por vírgulas.
2. Você quer que o resultado seja colocado a partir de A3, continuando por A4, A5, etc

Para obter esse resultado use: Separa Range("A1"), Range("A3")

Atenciosamente, 

Answer 2

Para eu chamar a função, eu tenho que digitar assim Separa Range("A1"), Range("A3")  em uma célula qualquer, ta dando erro...tentei sem aspas já......

valeu meu garoto.

Answer 3

Bom dia.

Tiago, o código acima é um procedimento (Sub) e não uma função (Function) e, como possui parâmetros, não pode ser chamado a partir de uma célula, mas de dentro do próprio VBA. Para tentar a melhor explicação, um embasamento teórico se faz necessário e é isso que tento passar a vc nas próximas linhas:

Por uma restrição (não confundir restrição com limitação) do Excel, uma função escrita em VBA só pode alterar o conteúdo de células quando não for projetada para ser invocada de dentro de uma célula (como parte de uma fórmula, por exemplo). Como o procedimento acima descrito altera o conteúdo de células (a partir de A3, por exemplo) ele não pode ser invocado a partir de uma fórmula e, exatamente por isso, foi projetado como Sub e não como Function. Uma vez que possui parâmetros, para torná-lo mais genérico, tambem não pode ser invocado através do comando de menú Ferramentas, Macro, Macros ...

Assim você deve acrescentar ao seu módulo um outro procedimento que invoque o código que te passei com valores específicos para os parâmetros e que, ao mesmo tempo, não possua parâmetros, de forma a poder ser invocado como uma Macro pelo Excel.

Face ao acima exposto, imaginemos o cenário específico em que você tenha um conjunto de palavras separadas por vírgulas na célula A1 e queira que estas palavras apareçam separadas a partir da célula A3. Para esse caso específico você deve proceder como segue:

1. Copie o seguinte código para um módulo de código padrão do VBA (pode ser o mesmo onde você colou o código para Separa():
   

   Public Sub SeparaEmA1ParaA3()
     Separa Range("A1"), Range("A3")
   End Sub
   
   

2. Agora, de dentro de sua planilha, você pode invocar o procedimento acima usando o menú Ferramentas, Macro, Macros ... e selecionando a macro SeparaEmA1ParaA3 que aparece na listagem. 

Sei que parece chato esse monte de considerações teóricas, mas é através delas, e somente delas, que se consegue escrever códigos robustos. Caso você não consiga adaptar o código às suas necessidades específicas, poste aqui a célula onde estão as palavras separadas por vírgula, a célula a partir da qual você quer os resultados e eu criarei o código específico para aquela situação.

Atenciosamente,

 

Answer 4

Po Otávio, vc é show de bola heim cara, muito obrigado mesmo.........

O código faz o que eu quero....só gostaria de deletar os dados da coluna antes de passar os dados da célula para coluna..........

se não tiver muito ocupado pode me explicar o que faz o procedimento?

ou somente as funcao

IsEmpty(rngOrigem.Value) => Essa parace que verifica se a célula está vazia né....

Split(CStr(rngOrigem.Value) =>

LBound(aTokens) =>

UBound(aTokens) =>

rngDestino.Offset(intOffset, 0).Value = aTokens(lngIndice)   =>

 

Valeu meu garotooooooooo

Answer 5

Olá,

alterei o código para que as células de destino sejam limpas antes de serem preenchidas com os novos resultados:

Public Sub Separa(rngOrigem As Range, rngDestino As Range)
  'aTokens receberá uma matriz com todas as palavras
  'individuais extraídas
  Dim aTokens As Variant
  'Índice para acessar cada elemento individual de aTokens
  Dim lngIndice As Long
  'intOffset guardará o deslocamento da próxima célula a
  'preencher, com base na célula inicial rngDestino
  Dim intOffset As Integer
  'Última célula preenchida, abaixo de rngDestino
  'Este procedimento apagará o conteúdo de todas as
  'células no intervalo rngDestino:rngUltimaCelula
  Dim rngUltimaCelula As Range
  'Primeiramente, verifica se existe um valor informado
  'em rngOrigem
  If (Not IsEmpty(rngOrigem.Value)) Then
    'Cria uma matriz com o texto em rngOrigem.Value
    'devidamente separado através das ocorrências das vírgulas
    'Assim, o texto Otávio,Alves,Ribeiro "preencherá"
    'aTokens com uma matriz de tres elementos a saber:
    '
    'aTokens(0)="Otávio"
    'aTokens(1)="Alves"
    'aTokens(2)="Ribeiro"
    aTokens = Split(CStr(rngOrigem.Value), ",")
    'Verifica se aTokens foi "preenchido" corretamente,
    'prossegue.
    If (Not IsEmpty(aTokens)) Then
      'Prepara-se para apagar o conteúdo do intervalo que
      'se inicia em rngDestino e se estende até
      'a última célula preenchida abaixo dela (contígua)
      Set rngUltimaCelula = rngDestino.End(xlDown)
      Range(rngDestino, rngUltimaCelula).ClearContents
      'A primeira célula a ser preenchida com os resultados
      'está a ZERO linhas abaixo de rngDestino, portanto ela mesma
      intOffset = 0
      'LBound pega o índice do primeiro elemento de aTokens
      'no caso, aTokens(LBound(aTokens)) retorna "Otávio"
      '
      'UBound retorna o índice do último elemento em aTokens
      'no caso aTokens(UBound(aTokens))="Ribeiro"
      For lngIndice = LBound(aTokens) To UBound(aTokens)
        'Preenche o intervalo a partir de rngDestino
        'com os valores presentes em aTokens
        rngDestino.Offset(intOffset, 0).Value = aTokens(lngIndice)
        'informa que o próximo resultado deve ser colocado
        'uma linha abaixo do resultado anterior
        intOffset = intOffset + 1
      Next lngIndice
    End If
  End If
End Sub

Atenciosamente,

Answer 6

Valeu...quando eu chegar no serviço vou testar...po valeu mesmo, cara qq coisa pode mandar email.........sql, php, o que puder eu ajudo...