Excel Montar arquivo em formato separado por ponto e virgula

[williams.matos]

Possuo uma base com empresas que realizam serviços, tudo esta em uma única coluna, porém necessito inserir os serviços na frente de cada empresa prestadora que esta representada por uma código numérico, separado por ponto e virgula dentro de uma célula.

prestadores_skill.xlsx

[ricardo_br]

@williams.matos Poderia prover alguns exemplos de como deveria ficar o resultado esperado? 

[Midori]

@williams.matos Isso pode ser feito com macro.

[williams.matos]

@ricardo_br Dentro do arquivo deixei um exemplo de como preciso deixar. Grato

@Midori Não possuo conhecimento em Macros, conseguiria me ajudar com isso?

[Midori]

@williams.matos Veja se assim resolve, o arquivo será salvo no mesmo diretório da planilha,

 

Sub CriaArquivoCSV()
    Dim Tabela      As ListObject
    Dim Registro    As Range
    Dim StrLinha    As String
    Dim ID          As String
    Dim ArquivoCSV  As Integer
    
    Set Tabela = ThisWorkbook.Sheets("Planilha1").[Tabela2].ListObject
    ArquivoCSV = FreeFile
    Open ThisWorkbook.Path & "\ArquivoTeste.csv" For Append As ArquivoCSV

    If Not Tabela.DataBodyRange Is Nothing Then
        ID = Tabela.DataBodyRange.Rows.Cells(1, 1).Value
        For Each Registro In Tabela.DataBodyRange.Rows
            If ID <> Registro.Columns(1).Value Then
                Print #ArquivoCSV, ID & StrLinha
                StrLinha = ""
            End If
            StrLinha = StrLinha & ";" & Registro.Columns(4).Value
            ID = Registro.Columns(1).Value
        Next Registro
    End If

    Close ArquivoCSV
End Sub

 

[williams.matos]

Em 31/10/2023 às 11:13, Midori disse:

@williams.matos Veja se assim resolve, o arquivo será salvo no mesmo diretório da planilha,

 

Sub CriaArquivoCSV()
    Dim Tabela      As ListObject
    Dim Registro    As Range
    Dim StrLinha    As String
    Dim ID          As String
    Dim ArquivoCSV  As Integer
    
    Set Tabela = ThisWorkbook.Sheets("Planilha1").[Tabela2].ListObject
    ArquivoCSV = FreeFile
    Open ThisWorkbook.Path & "\ArquivoTeste.csv" For Append As ArquivoCSV

    If Not Tabela.DataBodyRange Is Nothing Then
        ID = Tabela.DataBodyRange.Rows.Cells(1, 1).Value
        For Each Registro In Tabela.DataBodyRange.Rows
            If ID <> Registro.Columns(1).Value Then
                Print #ArquivoCSV, ID & StrLinha
                StrLinha = ""
            End If
            StrLinha = StrLinha & ";" & Registro.Columns(4).Value
            ID = Registro.Columns(1).Value
        Next Registro
    End If

    Close ArquivoCSV
End Sub

 

Como utilizo? como comentei antes eu não conheço MACRO, eu até inseri esse código que me enviou la onde cria Macro no excel, mas não sei como fazer executar e trazer o resultado, desculpe insistir mas conseguiria usar meu arquivo inserindo essa macro nele? pois ai entenderia melhor, nunca mexi em Macro nem VBA.

[Midori]

22 minutos atrás, williams.matos disse:

eu até inseri esse código que me enviou la onde cria Macro no excel, mas não sei como fazer executar

Salve a planilha com a extensão xlsm. Para executar a macro abra o módulo (pode ser com Alt+F11) onde colou o código e digite F5.

[williams.matos]

8 minutos atrás, Midori disse:

Salve a planilha com a extensão xlsm. Para executar a macro abra o módulo (pode ser com Alt+F11) onde colou o código e digite F5.

Fiz este processo, mas parece nada acontecer, ele deveria gerar um novo arquivo em csv?

[Midori]

@williams.matos O arquivo "ArquivoTeste.csv" será criado no mesmo diretório onde a planilha foi salva

[williams.matos]

24 minutos atrás, Midori disse:

@williams.matos O arquivo "ArquivoTeste.csv" será criado no mesmo diretório onde a planilha foi salva

Deu certo meu amigo, muito obrigado!

[DJunqueira]

Forma alternativa de resolver este caso utilizando o Power Query, resultado final na aba "Tabela2".
No vídeo abaixo (em inglês) é possível observar como foi produzida a solução.
Se não me falha a memória tb é possível exportar direto do porque p/ arquivo '.csv'.
 

 

prestadores_skill com PQ por DJ.xlsx

[DJunqueira]

Tb tem essa solução com fórmula, mas q penso q poderia estar mais um pouco elaborada.
A fórmula está aplicada na planilha anexa.

=UNIRTEXTO(";";;A2;FILTRO(Tabela2[SKILL];Tabela2[ID_PRESTADOR]=A2))

 

prestadores_skill com fórmula por DJ.xlsx