Valores em uma célula separados por ponto e vírgula e colocar um embaixo do outro até ter algum valor após o ponto e virgula

[Arthur Esteves]

Bom dia! Bem Noob em VBA. Gostaria de ajuda, tenho um desafio para fazer para faculdade. Eu preciso fazer um código que leia uma linha da planilha e na celular perfil pegar a célula que tem muitos valores separados por ponto e vírgula. Aí eu tenho que criar uma linha embaixo e colocar um por um até não ter mais, copiar os valores das outras células e partir para a próxima linha e fazer o mesmo. Linha modelo e como deve ficar abaixo. Estou ficando louco e não acho nada pra ler e tentar.

 

Código Funcionário Nome do Funcionário Dt.Demissão Sistema Perfil Dt_Registro Código Dependência Nome Dependência

3777448 JOSE MANOEL PEREIRA DA SILVA 11/05/2021 SSRH Opc1; Opc2; Opc3; Opc4; Opc5; Opc6; Opc7; Opc8; Opc9; Opc10; Opc11 17/05/2021 2507 CEASA RIO-URJ

[Luana Bailon]

Boa tarde, veja se esse código pode te ajudar, antes de testar o código, por favor faça uma cópia do seu arquivo, só por precaução. Não mencionei planilha, então é melhor tentar usar só nessa planilha.

Sub preencher()

Dim VetorPerfil As Variant
Dim tlinha As Long, i As Long

VetorPerfil = Split(Range("e3").Value, ";")

tlinha = Range("a7").End(xlDown).Row + 1

For i = 0 To UBound(VetorPerfil)
    Cells(tlinha, 1) = Range("A3").Value
    Cells(tlinha, 2) = Range("b3").Value
    Cells(tlinha, 3) = CDate(Range("c3").Value)
    Cells(tlinha, 4) = Range("d3").Value
    Cells(tlinha, 5) = VetorPerfil(i)
    Cells(tlinha, 6) = CDate(Range("f3").Value)
    Cells(tlinha, 7) = Range("g3").Value
    Cells(tlinha, 8)= Range("h3").Value
    tlinha = tlinha + 1
Next

End Sub

Editado Junho 26, 2021 por Luana Bailon

[Luana Bailon]

Em 01/07/2021 em 14:09, Arthur Esteves disse:

Oi, Luana, tudo bem? Deu tudo certo, porem esse era o modelo, o original tem mais de 100 linhas e queria fazer com todos. Eu mexi e tentei fazer um for em cima do for, contudo continuar trazendo somente a primeira linha. Consegue me ajudar para que o código começa na linha 101 e separe todos acima?

Boa tarde, tudo sim e com você? Poderia disponibilizar a planilha, se possível, ou mandar uma foto só para basear? Não deu pra entender direito.

Mas seria algo assim?

https://drive.google.com/file/d/1ewgNH7wRpdYACPo5BYF3eg54p82kE5yZ/view?usp=sharing

o código ficou assim : 

Sub preencher2()

Dim VetorPerfil As Variant
Dim tlinha As Long, i As Long
Dim colar As Long
Dim j As Long

tlinha = Planilha1.Range("a1").CurrentRegion.Rows.Count
colar = Planilha3.Range("a1").CurrentRegion.Rows.Count + 1

For i = 2 To tlinha
    VetorPerfil = Split(Planilha1.Cells(i, 5), ";")
        For j = 0 To UBound(VetorPerfil)
            Planilha3.Cells(colar, 1) = Planilha1.Cells(i, 1)
            Planilha3.Cells(colar, 2) = Planilha1.Cells(i, 2)
            Planilha3.Cells(colar, 3) = CDate(Planilha1.Cells(i, 3))
            Planilha3.Cells(colar, 4) = Planilha1.Cells(i, 4)
            Planilha3.Cells(colar, 5) = VetorPerfil(j)
            Planilha3.Cells(colar, 6) = CDate(Planilha1.Cells(i, 6))
            Planilha3.Cells(colar, 7) = Planilha1.Cells(i, 7)
            Planilha3.Cells(colar, 8)= Planilha1.Cells(i, 8)
            colar = colar + 1
        Next
Next
    Planilha3.Range("a1").CurrentRegion.EntireColumn.AutoFit
    
End Sub

 

Editado Julho 3, 2021 por Luana Bailon

[Arthur Esteves]

Em 26/06/2021 em 16:30, Luana Bailon disse:

Boa tarde, veja se esse código pode te ajudar, antes de testar o código, por favor faça uma cópia do seu arquivo, só por precaução. Não mencionei planilha, então é melhor tentar usar só nessa planilha.

Sub preencher()

Dim VetorPerfil As Variant
Dim tlinha As Long, i As Long

VetorPerfil = Split(Range("e3").Value, ";")

tlinha = Range("a7").End(xlDown).Row + 1

For i = 0 To UBound(VetorPerfil)
    Cells(tlinha, 1) = Range("A3").Value
    Cells(tlinha, 2) = Range("b3").Value
    Cells(tlinha, 3) = CDate(Range("c3").Value)
    Cells(tlinha, 4) = Range("d3").Value
    Cells(tlinha, 5) = VetorPerfil(i)
    Cells(tlinha, 6) = CDate(Range("f3").Value)
    Cells(tlinha, 7) = Range("g3").Value
    Cells(tlinha, 8)= Range("h3").Value
    tlinha = tlinha + 1
Next

End Sub

Oi, vi agora Luana. Muito obrigado! Porém dá um erro quando chega na primeira linha após o For. Não entendi o que poderia ser.

[Luana Bailon]

2 horas atrás, Arthur Esteves disse:

Oi, vi agora Luana. Muito obrigado! Porém dá um erro quando chega na primeira linha após o For. Não entendi o que poderia ser.

 

 

26 minutos atrás, Luana Bailon disse:

Acho que talvez porque a planilha está diferente, fiz baseado naquela primeira foto que você mandou

https://drive.google.com/file/d/1AKFOGZzkZJ0aA_bsDb9VUDUTm8TZAjUj/view?usp=sharing

 

Editado Junho 29, 2021 por Luana Bailon

[Arthur Esteves]

31 minutos atrás, Luana Bailon disse:

 

 

 

Luana, muito obrigado. Achei o problema e ajeitei. Muito obrigado mesmo. 🥰

[Arthur Esteves]

Em 26/06/2021 em 16:30, Luana Bailon disse:

Boa tarde, veja se esse código pode te ajudar, antes de testar o código, por favor faça uma cópia do seu arquivo, só por precaução. Não mencionei planilha, então é melhor tentar usar só nessa planilha.

Sub preencher()

Dim VetorPerfil As Variant
Dim tlinha As Long, i As Long

VetorPerfil = Split(Range("e3").Value, ";")

tlinha = Range("a7").End(xlDown).Row + 1

For i = 0 To UBound(VetorPerfil)
    Cells(tlinha, 1) = Range("A3").Value
    Cells(tlinha, 2) = Range("b3").Value
    Cells(tlinha, 3) = CDate(Range("c3").Value)
    Cells(tlinha, 4) = Range("d3").Value
    Cells(tlinha, 5) = VetorPerfil(i)
    Cells(tlinha, 6) = CDate(Range("f3").Value)
    Cells(tlinha, 7) = Range("g3").Value
    Cells(tlinha, 8)= Range("h3").Value
    tlinha = tlinha + 1
Next

End Sub

Oi, Luana, tudo bem? Deu tudo certo, porem esse era o modelo, o original tem mais de 100 linhas e queria fazer com todos. Eu mexi e tentei fazer um for em cima do for, contudo continuar trazendo somente a primeira linha. Consegue me ajudar para que o código começa na linha 101 e separe todos acima?

[Arthur Esteves]

Em 03/07/2021 em 14:26, Luana Bailon disse:

Boa tarde, tudo sim e com você? Poderia disponibilizar a planilha, se possível, ou mandar uma foto só para basear? Não deu pra entender direito.

Mas seria algo assim?

https://drive.google.com/file/d/1ewgNH7wRpdYACPo5BYF3eg54p82kE5yZ/view?usp=sharing

o código ficou assim : 

Sub preencher2()

Dim VetorPerfil As Variant
Dim tlinha As Long, i As Long
Dim colar As Long
Dim j As Long

tlinha = Planilha1.Range("a1").CurrentRegion.Rows.Count
colar = Planilha3.Range("a1").CurrentRegion.Rows.Count + 1

For i = 2 To tlinha
    VetorPerfil = Split(Planilha1.Cells(i, 5), ";")
        For j = 0 To UBound(VetorPerfil)
            Planilha3.Cells(colar, 1) = Planilha1.Cells(i, 1)
            Planilha3.Cells(colar, 2) = Planilha1.Cells(i, 2)
            Planilha3.Cells(colar, 3) = CDate(Planilha1.Cells(i, 3))
            Planilha3.Cells(colar, 4) = Planilha1.Cells(i, 4)
            Planilha3.Cells(colar, 5) = VetorPerfil(j)
            Planilha3.Cells(colar, 6) = CDate(Planilha1.Cells(i, 6))
            Planilha3.Cells(colar, 7) = Planilha1.Cells(i, 7)
            Planilha3.Cells(colar, 8)= Planilha1.Cells(i, 😎
            colar = colar + 1
        Next
Next
    Planilha3.Range("a1").CurrentRegion.EntireColumn.AutoFit
    
End Sub

 

Bom dia! 

 

Tudo bem, ótima segunda.

 

Sim, porém na mesma planilha, iniciando na próxima linha vazia, no caso teste seria na linha 102.

Eu mexi aqui e consegui fazer as alterações. Muitíssimo Obrigado!

Editado Julho 5, 2021 por Arthur Esteves