Página 1 de 1

Transpor com Inserir Linhas

Enviado: 02 Jul 2021 às 00:19
por gabiwol
Boa noite,

Tentei de todas as formas fazer pelo Excel mas devido a grande demanda de dados e a não possibilidade de fazer manualmente, creio que isso seja papo de VBA, na qual estou estudando ainda (sou nova no assunto)

Preciso transpor as linhas em coluna porém tem algumas condições:
- Se o tipo de item for "Serviço" preciso que insira 5 linhas de acordo com uma tabela específica para ele
- Se for qualquer outro tipo de item vai ser inserido 4 linhas com uma tabela fixa para eles
- Essas linhas que serão inseridas eu vou precisar preencher elas de acordo com a lista fixa (serviço e para os demais itens)

No anexo tem os dados atuais e como preciso que fique para melhor visualização, queria saber se há uma possibilidade de fazer isto e se puderem informar as "formulas" ideais, eu agradeço.
Transpor.xlsx

Re: Transpor com Inserir Linhas

Enviado: 02 Jul 2021 às 16:39
por Foxtri
Boa Tarde gabiwol.
Veja se o que foi feito atende a sua necessidade.
Até
Foxtri

Re: Transpor com Inserir Linhas

Enviado: 02 Jul 2021 às 20:13
por osvaldomp
Experimente o código abaixo. Funciona com qualquer quantidade de itens.
Para utilizar em outro arquivo basta colar uma cópia do código em um módulo comum do arquivo desejado. Para rodar o código utilize um botão, como no arquivo anexado, ou atalho de teclado ou Alt+F8.
Código: Selecionar todos
Sub RearranjaDados()
 Dim ci As Range, ws As Worksheet, LR As Long
  Set ws = ActiveSheet
  Sheets.Add
  [A1:D1] = Array("COD ITEM", "GERAL/SERVIÇ", "CL", "LC")
  For Each ci In ws.Range("A2:A" & ws.Cells(Rows.Count, 1).End(3).Row)
   LR = Cells(Rows.Count, 1).End(3).Row
   If ci.Offset(, 4).Value = "SERVIÇO" Then
    Cells(LR + 1, 1).Resize(5).Value = ci.Value
    Cells(LR + 1, 2).Resize(5).Value = ws.[L2:L6].Value
    Cells(LR + 1, 3).Resize(5).Value = Application.Transpose(Array("NCM", "NCM 01", "CATALOGO 01", "TIPO", "NOME ITEM"))
    Cells(LR + 1, 4).Resize(5).Value = Application.Transpose(ci.Offset(, 1).Resize(, 5).Value)
   Else
    Cells(LR + 1, 1).Resize(4).Value = ci.Value
    Cells(LR + 1, 2).Resize(4).Value = ws.[J2:J5].Value
    Cells(LR + 1, 3).Resize(4).Value = Application.Transpose(Array("NCM", "CATALOGO 01", "TIPO", "NOME ITEM"))
    Cells(LR + 1, 4) = ci.Offset(, 1).Value
    Cells(LR + 2, 4).Resize(3).Value = Application.Transpose(ci.Offset(, 3).Resize(, 3).Value)
   End If
  Next ci
  Columns("A:D").AutoFit
End Sub

Re: Transpor com Inserir Linhas

Enviado: 02 Jul 2021 às 21:06
por gabiwol
Foxtri escreveu: 02 Jul 2021 às 16:39 Boa Tarde gabiwol.
Veja se o que foi feito atende a sua necessidade.
Até
Foxtri
Excelente, funcionou exatamente como eu precisava.
Obrigado! Me salvou e ainda vai me ajudar a compreender/estudar. :D

Re: Transpor com Inserir Linhas

Enviado: 02 Jul 2021 às 21:09
por gabiwol
osvaldomp escreveu: 02 Jul 2021 às 20:13 Experimente o código abaixo. Funciona com qualquer quantidade de itens.
Para utilizar em outro arquivo basta colar uma cópia do código em um módulo comum do arquivo desejado. Para rodar o código utilize um botão, como no arquivo anexado, ou atalho de teclado ou Alt+F8.
Código: Selecionar todos
Sub RearranjaDados()
 Dim ci As Range, ws As Worksheet, LR As Long
  Set ws = ActiveSheet
  Sheets.Add
  [A1:D1] = Array("COD ITEM", "GERAL/SERVIÇ", "CL", "LC")
  For Each ci In ws.Range("A2:A" & ws.Cells(Rows.Count, 1).End(3).Row)
   LR = Cells(Rows.Count, 1).End(3).Row
   If ci.Offset(, 4).Value = "SERVIÇO" Then
    Cells(LR + 1, 1).Resize(5).Value = ci.Value
    Cells(LR + 1, 2).Resize(5).Value = ws.[L2:L6].Value
    Cells(LR + 1, 3).Resize(5).Value = Application.Transpose(Array("NCM", "NCM 01", "CATALOGO 01", "TIPO", "NOME ITEM"))
    Cells(LR + 1, 4).Resize(5).Value = Application.Transpose(ci.Offset(, 1).Resize(, 5).Value)
   Else
    Cells(LR + 1, 1).Resize(4).Value = ci.Value
    Cells(LR + 1, 2).Resize(4).Value = ws.[J2:J5].Value
    Cells(LR + 1, 3).Resize(4).Value = Application.Transpose(Array("NCM", "CATALOGO 01", "TIPO", "NOME ITEM"))
    Cells(LR + 1, 4) = ci.Offset(, 1).Value
    Cells(LR + 2, 4).Resize(3).Value = Application.Transpose(ci.Offset(, 3).Resize(, 3).Value)
   End If
  Next ci
  Columns("A:D").AutoFit
End Sub
Lhe agradeço também pela ajuda, está funcionando perfeitamente! :D