Fóruns
Microsoft Excel - 2...
2024 - VBA & Macros
Transpor dados para...
 
Notifications
Clear all

Transpor dados para coluna com informação variavel nas linha

 
2024 - VBA & Macros
Post Recente por leandro_vf 8 anos atrás
5 Posts
3 Usuários
0 Reactions
1,001 Visualizações
RSS
 leandro_vf
(@leandro_vf)
Posts: 15
Active Member
Topic starter
 

Prezados Boa Tarde,

Tenho que montar um BD a partir de uma tabela mal feita. É que as informações estão dispostas nas linhas, com numeros de dados variaveis. Preciso de uma Macro para Transpor os dasdos das linhas para as colunas inserindo na primeira linha baixo e repetindo informação da primeira coluna. Segue exemplo em anexo.

Agradeço atenção de todos

 
Postado : 24/05/2017 11:16 am
Wagner Morel
 Wagner Morel
(@wagner-morel-vidal-nobre)
Posts: 0
Illustrious Member
 

leandro_vf,

Boa tarde!

Veja se é assim.

Exemplo.zip

Desenvolvo pequenas soluções em VBA Excel a valores que variam entre R$ 50,00 a R$ 200,00. Se te interessar, entre no meu instagran (vba_excel_desenvolvimento)

Atenciosamente
Wagner Morel

 
Postado : 24/05/2017 12:41 pm
 Osvaldomp
(@osvaldomp)
Posts: 857
Prominent Member
 

Resultado a partir de 'M1'.

Sub TransporDados()
 Dim n As Range, k As Long, m As Long
  For Each n In Range("A3:A" & Cells(Rows.Count, 1).End(3).Row)
   k = Application.CountA(Range(n, n.End(xlToRight))) - 1
   Cells(m + 1, 13).Resize(k).Value = n.Value
   Cells(m + 1, 14).Resize(k).Value = Application.Transpose(n.Offset(, 1).Resize(, k).Value)
   m = m + k
  Next n
End Sub

Osvaldo

 
Postado : 24/05/2017 1:12 pm
 leandro_vf
(@leandro_vf)
Posts: 15
Active Member
Topic starter
 

leandro_vf,

Boa tarde!

Veja se é assim.

É isso mesmo obrigado

 
Postado : 24/05/2017 2:50 pm
 leandro_vf
(@leandro_vf)
Posts: 15
Active Member
Topic starter
 

Resultado a partir de 'M1'.

Sub TransporDados()
 Dim n As Range, k As Long, m As Long
  For Each n In Range("A3:A" & Cells(Rows.Count, 1).End(3).Row)
   k = Application.CountA(Range(n, n.End(xlToRight))) - 1
   Cells(m + 1, 13).Resize(k).Value = n.Value
   Cells(m + 1, 14).Resize(k).Value = Application.Transpose(n.Offset(, 1).Resize(, k).Value)
   m = m + k
  Next n
End Sub

Perfeito amigo!!! É isso mesmo

 
Postado : 24/05/2017 2:50 pm
Forum Jump:
  Tópico Anterior
Próximo Tópico