Ir ao conteúdo
  • Cadastre-se
Eloize Teixeira

RESOLVIDO Transpor linha para coluna

Recommended Posts

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 :tw_dissapointed_relieved:

 

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

Compartilhar este post


Link para o post
Compartilhar em outros sites

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

 

  • Curtir 2

Compartilhar este post


Link para o post
Compartilhar em outros sites

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

  • Curtir 1

Compartilhar este post


Link para o post
Compartilhar em outros sites

@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.

Compartilhar este post


Link para o post
Compartilhar em outros sites
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!

 

Compartilhar este post


Link para o post
Compartilhar em outros sites
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.

Compartilhar este post


Link para o post
Compartilhar em outros sites

Crie uma conta ou entre para comentar

Você precisar ser um membro para fazer um comentário

Criar uma conta

Crie uma nova conta em nossa comunidade. É fácil!

Crie uma nova conta

Entrar

Já tem uma conta? Faça o login.

Entrar agora





Sobre o Clube do Hardware

No ar desde 1996, o Clube do Hardware é uma das maiores, mais antigas e mais respeitadas publicações sobre tecnologia do Brasil. Leia mais

Direitos autorais

Não permitimos a cópia ou reprodução do conteúdo do nosso site, fórum, newsletters e redes sociais, mesmo citando-se a fonte. Leia mais

×