Transpor linha para coluna

Eloize Teixeira · 28 de julho de 2016

Bom dia,

Estou desenvolvendo uma macro para importar um grande número de dados para o SAP, porém ele precisa estar no layout correto.

Pois bem, os dados iniciais foram digitados em linhas e preciso que parte deles fique em coluna. (vide Exemplo planilha em anexo).

Escrevi um código levando em consideração exemplos de um colega, mas não consigo terminar a parte de não substituir alguns dados. (vide planilha)..

Abaixo o código.

Please, poderiam me ajudar? Urgente

Sub Replicadados()
 Dim LRo As Long, LRd As Long, ND As Range
 
  Sheets("Teste").Range("A1") = "CABECA"
  Sheets("Teste").Range("A2") = "LINHA"
  Sheets("Teste").Range("B1") = "OBJECT"
  Sheets("Teste").Range("B2") = "TEXTTYPE"
  Sheets("Teste").Range("C1") = "IDH"
  Sheets("Teste").Range("C2") = "TEXT"
  Sheets("Teste").Range("D1") = "ORG"
  Sheets("Teste").Range("E1") = "CANAL"
  Sheets("Teste").Range("F1") = "SETOR"
  Sheets("Teste").Range("G1") = "TEXTID"
  Sheets("Teste").Range("H1") = "LANGUAGE"

  LRo = Cells(Rows.Count, 1).End(xlUp).Row: If LRo < 7 Then Exit Sub
  
  For Each ND In Range("A7:A" & LRo)
   With Sheets("Teste")
   
    LRd = .Cells(Rows.Count, 1).End(xlUp).Row
     .Cells(LRd + 1, 1) = "H"
     .Cells(LRd + 2, 1) = "I"
     .Cells(LRd + 1, 2) = Cells(ND.Row, "E")
     .Cells(LRd + 2, 2) = "*"
     .Cells(LRd + 1, 3) = Cells(ND.Row, "D")
     .Cells(LRd + 2, 3) = "Shelf Life (dias): " & Cells(ND.Row, "K")
     .Cells(LRd + 3, 3) = "Aceita Saldo?: " & Cells(ND.Row, "L")
     .Cells(LRd + 4, 3) = "Fornecimento completo?: " & Cells(ND.Row, "M")
     .Cells(LRd + 5, 3) = "Aceita NF do Mês ANTERIOR?: " & Cells(ND.Row, "N")
     .Cells(LRd + 6, 3) = "Qtd de dias que podemos antecipar a entrega: " & Cells(ND.Row, "O")
     .Cells(LRd + 7, 3) = "Necessita de agendamento?: " & Cells(ND.Row, "P")
     .Cells(LRd + 8, 3) = "Responsável agendamento: " & Cells(ND.Row, "Q")
     .Cells(LRd + 9, 3) = "Permitido agrupamento de pedidos x NF: " & Cells(ND.Row, "R")
     .Cells(LRd + 1, 4) = Cells(ND.Row, "A")
     .Cells(LRd + 1, 5) = Cells(ND.Row, "B")
     .Cells(LRd + 1, 6) = Cells(ND.Row, "C")
     .Cells(LRd + 1, 7) = "ZC01"
     .Cells(LRd + 1, 8) = "P"
    
   End With
  Next ND
End Sub

Como sai:

CABECA	OBJECT	IDH	ORG	CANAL	SETOR	TEXTID	LANGUAGE
LINHA	TEXTTYPE	TEXT					
H	Fulano	1140795	442	T3	38	ZC01	P
I	*	Shelf Life (dias): 45					
H	Ciclano	2196178	442	T3	38	ZC01	P
I	*	Shelf Life (dias): 30					
H	Extrafano	378141	442	T3	38	ZC01	P
I	*	Shelf Life (dias): 30					
		Aceita Saldo?: SIM					
		Fornecimento completo?: NÃO					
		Aceita NF do Mês ANTERIOR?: SIM					
		Qtd de dias que podemos antecipar a entrega: Não podemos antecipar (seguir Leatime)					
		Necessita de agendamento?: NÃO					
		Responsável agendamento: Sem agendamento					
		Permitido agrupamento de pedidos x NF: NÃO

Como gostaria que saísse:

CABECA	OBJECT	IDH	ORG	CANAL	SETOR	TEXTID	LANGUAGE
LINHA	TEXTTYPE	TEXT					
H	Fulano	1140795	442	T3	38	ZC01	P
I	*	Shelf Life (dias): 45					
I	*	Aceita Saldo?: SIM					
I	*	Fornecimento completo?: NÃO					
I	*	Aceita NF do Mês ANTERIOR?: SIM					
I	*	Qtd de dias que podemos antecipar a entrega: Não podemos antecipar (seguir Leatime)					
I	*	Necessita de agendamento?: NÃO					
I	*	Responsável agendamento: Sem agendamento					
I	*	Permitido agrupamento de pedidos x NF: SIM					
H	Ciclano	2196178	442	T3	38	ZC01	P
I	*	Shelf Life (dias): 30					
I	*	Aceita Saldo?: SIM					
I	*	Fornecimento completo?: NÃO					
I	*	Aceita NF do Mês ANTERIOR?: SIM					
I	*	Qtd de dias que podemos antecipar a entrega: Não podemos antecipar (seguir Leatime)					
I	*	Necessita de agendamento?: NÃO					
I	*	Responsável agendamento: Sem agendamento					
I	*	Permitido agrupamento de pedidos x NF: SIM					
H	Extrafano	378141	442	T3	38	ZC01	P
I	*	Shelf Life (dias): 30					
I	*	Aceita Saldo?: SIM					
I	*	Fornecimento completo?: NÃO					
I	*	Aceita NF do Mês ANTERIOR?: SIM					
I	*	Qtd de dias que podemos antecipar a entrega: Não podemos antecipar (seguir Leatime)					
I	*	Necessita de agendamento?: NÃO					
I	*	Responsável agendamento: Sem agendamento					
I	*	Permitido agrupamento de pedidos x NF: NÃO

Planilha Particularidades mod.ddd .zip

Eloize Teixeira · 28 de julho de 2016

@osvaldomp @Basole

DJunqueira · 28 de julho de 2016

Qual é a sua versão do Excel?

Eloize Teixeira · 28 de julho de 2016

@DJunqueira 2013

Me ajuda?

Preciso muito muito.

DJunqueira · 28 de julho de 2016

Quero ajudar, mas só vou poder mais tarde.

Mais um pouco vou sair...

2013 é bom, vou poder fazer uns truques legais.

Eloize Teixeira · 28 de julho de 2016

@DJunqueira Muito obrigada. Desde já agradeço à atenção.

29 de julho de 2016

Experimente:

Sub ReplicaDados()
 Dim ov As Range, m As Long, v As Long, wso As Worksheet, LR As Long, LC As Long
 Set wso = Sheets("Atual")
 Application.ScreenUpdating = False
  With Sheets("Esperado")
   .Cells.Value = ""
   .Range("A1").Resize(, 8) = _
  [{ "CABECA","OBJECT" , "IDH","ORG","CANAL","SETOR","TEXTID","LANGUAGE"}]
  .Range("A2").Resize(, 3) = _
  [{ "LINHA","TEXTTYPE" , "TEXT"}]
  LC = wso.Cells(1, Columns.Count).End(1).Column
  For Each ov In wso.Range("A3:A" & wso.Cells(Rows.Count, 1).End(3).Row)
   m = 11
   Do
    LR = .Cells(Rows.Count, 3).End(3).Row
    .Cells(LR + 1, 1) = "H": .Cells(LR + 1, 4) = ov.Value
    .Cells(LR + 1, 5) = ov.Offset(, 1).Value
    .Cells(LR + 1, 6) = ov.Offset(, 2).Value
    .Cells(LR + 1, 3) = ov.Offset(, 3).Value
    .Cells(LR + 1, 2) = ov.Offset(, 4).Value
    .Cells(LR + 1, 7) = Right(wso.Cells(1, m), 4): .Cells(LR + 1, 8) = "p"
    If m < LC Then
     v = wso.Cells(1, m).End(2).Column
     wso.Range(wso.Cells(2, m), wso.Cells(2, v - 1)).Copy
     .Cells(LR + 2, 3).PasteSpecial Paste:=xlValues, Transpose:=True
     wso.Range(wso.Cells(ov.Row, m), wso.Cells(ov.Row, v - 1)).Copy
     .Cells(LR + 2, 4).PasteSpecial Paste:=xlValues, Transpose:=True
     m = wso.Cells(1, m).End(2).Column
    Else
     wso.Range(wso.Cells(2, m), wso.Cells(2, m + 1)).Copy
     .Cells(LR + 2, 3).PasteSpecial Paste:=xlValues, Transpose:=True
     wso.Range(wso.Cells(ov.Row, m), wso.Cells(ov.Row, m + 1)).Copy
     .Cells(LR + 2, 4).PasteSpecial Paste:=xlValues, Transpose:=True
     Exit Do
    End If
   Loop
  Next ov
   .Range("A4:A" & .Cells(Rows.Count, 3).End(3).Row).SpecialCells(xlBlanks).Value = "I"
   .Range("B4:B" & .Cells(Rows.Count, 3).End(3).Row).SpecialCells(xlBlanks).Value = "*"
  End With
 Application.ScreenUpdating = True
End Sub

DJunqueira · 29 de julho de 2016

Qual é sua base de seleção?

Todos os registros, 5 últimos...?

você vai sempre querer criar uma aba nova ou ela pode ser fixa/oculta?

Seja como for vários pequenos detalhes ainda tem de ser esclarecidos, pois apesar da solução apresentada pelo Osvaldo ser muito boa ela demanda um nível mais elevado de conhecimento p/ fazer a manutenção, q se não for o seu caso gera um dependência de uma boa vontade q pode ou não está a sua disposição.

Na planilha q eu elaborei no Excel 2016 três novas abordagens podem ser elaboradas, ou você usa só funções para elaborar o relatório (o q pode demandar ajustes frequentes, mas requer menor nível de conhecimento na hora de fazer manutenção), ou você pode partir p/ uma simbiose entre funções e VBA sendo este último mais simples e fácil de fazer a manutenção se utilizado junto com funções, ou tem a solução com o uso de Nova Consulta q é bem descritiva e não demanda código, mas pode não estar disponível p/ sua versão do Excel (tem q testar).

A solução por Nova Consulta (Query Table) é muito boa e se eventualmente não funcionar num primeiro momento poderá vir a funcionar se você fizer um update do complemento (Novamente, tem q testar). Vá na aba Nova Consulta e no menu vá em Dados e clique em Atualizar Tudo. Se tudo funcionar bem com sua versão você poderá fazer alguns testes alterando os valores. Notar q a planilha é .xlsx, ou seja, não tem macro.

Planilha Particularidades v2016.xlsx

Eloize Teixeira · 29 de julho de 2016

@osvaldomp Da onde você veio Osvaldo? Rs Você chega com umas soluções de outro mundo. Deu certo.

adicionado 2 minutos depois

@DJunqueira Muito obrigada pela sua disposição em me ajudar. Visualizei e realmente pareceu correto, mas ela funcionaria para mais de 3000 linhas ?!

De qualquer forma obrigada! Arrasou.

DJunqueira · 29 de julho de 2016

A solução com Nova Consulta funciona com qq quantidade de linhas.

29 de julho de 2016

13 horas atrás, DJunqueira disse:

...pois apesar da solução apresentada pelo Osvaldo ser muito boa

Peço que você se abstenha de fazer avaliações/comentários não solicitados sobre as minhas postagens.

... solução apresentada pelo Osvaldo ser muito boa ela demanda um nível mais elevado de conhecimento p/ fazer a manutenção...

Bobagem! Macros não se desgastam, não se deterioram e nem se quebram com o uso, portanto MACROS NÃO NECESSITAM DE MANUTENÇÃO!

DJunqueira · 29 de julho de 2016

1 minuto atrás, osvaldomp disse:

Caramba Osvaldo, calma!

Eu elogiei sua solução e você ficou irritado???

Eu apenas ofereci uma solução diferente p/ a Eloize q preferiu ficar com a sua.

Manutenção no sentido de fazer alguma pequena alteração, separar mais alguma palavra, colocar separador de ":" pequenas coisas q ocorrem no dia a dia, até porque os dados são dinâmicos e mudam.

Quando expomos ideias paralelas aprendemos uns com os outros, eu guardei a sua macro para meu uso pois está muito boa. Se você reparar poucas vezes apresento alguma solução com macro, pois não sou tão bom e rápido quantos muitos como vocês.

Para muitas soluções apresentadas com uso de macro (em todos os fóruns) eu teria dificuldades de fazer alterações, penso q outras pessoas podem ter o mesmo problema e me solidarizo com elas, mas cada pessoa que recebe nossa ajuda é q sabe de si, não tenho a intenção de ser dono da verdade ou de ninguém. Particularmente gosto quando apresentam uma ideia melhor q a minha porque aí sou eu q aprendo (guardei sua macro...).

Enfim, desculpe qq coisa.