Fóruns
Microsoft Excel - 2...
2024 - VBA & Macros
Dividir dados de um...
 
Notifications
Clear all

Dividir dados de uma coluna em outras várias colunas.

 
2024 - VBA & Macros
Post Recente por ovelha070 10 anos atrás
14 Posts
4 Usuários
0 Reactions
1,615 Visualizações
RSS
 ovelha070
(@ovelha070)
Posts: 7
Active Member
Topic starter
 

Olá,
No meu trabalho recebo uma planilha com apenas uma coluna de diversos numeros em várias linhas (A1 - A5885), e eu estava procurando um jeito de distribuir em várias colunas para melhor visualização e impressão.
Achei esse código na internet que funcionou para o que eu quero, porém ele na hora de distribuir como 3 numeros de cada coluna (de 16,17,18,19,23...). Não estou conseguindo consertar o problema. Segue o código: 

Sub Dividir_Coluna()
    
    Dim lim&, curr&, addr$, ncol$
    
    curr = 1
    
    s = InputBox("Digite quantas linhas deve ter cada coluna:", "Configuração", "20")
    
    If (s <> "") Then
    
        lim = Val(s)
    
        While Range("A" & lim).Value <> ""
        
            addr = "A" & lim & ":A" & (2 * lim)
            Range(addr).Select
            Selection.Cut
            ncol = Mid(ActiveCell.Cells(0, ActiveCell.Column + curr).Address, 2, 1)
            Range(ncol & "1").Select
            ActiveSheet.Paste
            Range(addr).Select
            Selection.EntireRow.Delete
            curr = curr + 1
            DoEvents
        
        Wend
    
    End If
     
End Sub

Agradeço desde já pela ajuda.

Obrigado!

 
Postado : 15/07/2014 5:48 am
Fernando Fernandes
 Fernando Fernandes
(@fernandofernandes)
Posts: 43750
Illustrious Member
 

ovelha070,

Não acha melhor postar um exemplo em planilha para ficar mais fácil alguém do fórum lhe ajudar?

Att,

Existem mil maneiras de preparar Neston. Invente a sua!
http://www.youtube.com/ExpressoExcel

 
Postado : 15/07/2014 5:58 am
 Edcronos
(@edcronos)
Posts: 1006
Noble Member
 

para facilitar a implementação da solução
o ideal seria vc postar uma planilha de exemplo
de como é
e de como vc quer que fique.

Somente é impossíveis até que alguém faça
A logica está presa na irracionalidade humana, e morta nos que se consideram donos da verdade.

"ALGUM MODERADOR ME EXPULSE DO FÓRUM POR FAVOR"

 
Postado : 15/07/2014 5:59 am
Wagner Morel
 Wagner Morel
(@wagner-morel-vidal-nobre)
Posts: 0
Illustrious Member
 

ovelha070,

Bom Dia!

Não entendi nada...!

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 : 15/07/2014 6:02 am
 ovelha070
(@ovelha070)
Posts: 7
Active Member
Topic starter
 

Me desculpe, pois sou novo aqui HEHE'

Fiz um exemplo de como o Macro funciona.

- Na tabela "A" é Como a planilha chega para mim

- Logo após a execução do Macro ela distribui os numeros em várias colunas - Nesse caso eu que escolho em quantas linhas vou distribuir os números.

- O problema é que na transferência ele "Come" 3 numeros da sequencia, exemplo: 19 e 20 - 24,25,26,27,28,29,30 - 34,35...

Espero que me compreendam e me ajudem por favor.

Obrigado

https://drive.google.com/file/d/0BwMO_wt6UQulLURKRG1LTE9BOEU/edit?usp=sharing

 
Postado : 15/07/2014 6:36 am
 Edcronos
(@edcronos)
Posts: 1006
Noble Member
 

Sub Dividir_Coluna()

s = InputBox("Digite quantas linhas deve ter cada coluna:", "Configuração", "20")

If (s <> "") Then
cO = 1: loi = 1
cD = 3: ldi = 1: ld = ldi
lt = Range(Cells(loi, cO), Cells(Cells(Rows.Count, cO).End(xlUp), cO)).Rows.Count
For lo = loi To lt + loi
Cells(ld, cD).Value2 = Cells(lo, cO).Value2
ld = ld + 1
If ld = s + ldi Then ld = ldi: cD = cD + 1
Next
End If
End Sub

Somente é impossíveis até que alguém faça
A logica está presa na irracionalidade humana, e morta nos que se consideram donos da verdade.

"ALGUM MODERADOR ME EXPULSE DO FÓRUM POR FAVOR"

 
Postado : 15/07/2014 8:27 am
 ovelha070
(@ovelha070)
Posts: 7
Active Member
Topic starter
 

Sub Dividir_Coluna()

s = InputBox("Digite quantas linhas deve ter cada coluna:", "Configuração", "20")

If (s <> "") Then
cO = 1: loi = 1
cD = 3: ldi = 1: ld = ldi
lt = Range(Cells(loi, cO), Cells(Cells(Rows.Count, cO).End(xlUp), cO)).Rows.Count
For lo = loi To lt + loi
Cells(ld, cD).Value2 = Cells(lo, cO).Value2
ld = ld + 1
If ld = s + ldi Then ld = ldi: cD = cD + 1
Next
End If
End Sub

É exatamente isso amigo, mas seria distribuido a partir da coluna "A", ou seja, a função é para cortar e colar nas demais colunas, apagando a original.

Já agradeço pela ajuda e força que está dando amigo, estou muito estressado tentando resolver isso e a chefe quer uma solução.

 
Postado : 15/07/2014 8:33 am
 Edcronos
(@edcronos)
Posts: 1006
Noble Member
 

Sub Dividir_Coluna()

s = InputBox("Digite quantas linhas deve ter cada coluna:", "Configuração", "20")

If (s <> "") Then
cO = 1: loi = 1
cD = 1: ldi = 1: ld = ldi
lt = Range(Cells(loi, cO), Cells(Cells(Rows.Count, cO).End(xlUp), cO)).Rows.Count
For lo = loi To lt + loi
d = Cells(lo, cO).Value2
Cells(lo, cO).Value2 = ""
Cells(ld, cD).Value2 = d
ld = ld + 1
If ld = s + ldi Then ld = ldi: cD = cD + 1
Next
End If
End Sub

Somente é impossíveis até que alguém faça
A logica está presa na irracionalidade humana, e morta nos que se consideram donos da verdade.

"ALGUM MODERADOR ME EXPULSE DO FÓRUM POR FAVOR"

 
Postado : 15/07/2014 8:39 am
 ovelha070
(@ovelha070)
Posts: 7
Active Member
Topic starter
 

Sub Dividir_Coluna()

s = InputBox("Digite quantas linhas deve ter cada coluna:", "Configuração", "20")

If (s <> "") Then
cO = 1: loi = 1
cD = 1: ldi = 1: ld = ldi
lt = Range(Cells(loi, cO), Cells(Cells(Rows.Count, cO).End(xlUp), cO)).Rows.Count
For lo = loi To lt + loi
d = Cells(lo, cO).Value2
Cells(lo, cO).Value2 = ""
Cells(ld, cD).Value2 = d
ld = ld + 1
If ld = s + ldi Then ld = ldi: cD = cD + 1
Next
End If
End Sub

Muito Obrigado por compartilhar sua inteligência.

Espero poder retribuir esse grande favor, ajudando aqui no forum.

Obrigado!!!

 
Postado : 15/07/2014 8:45 am
 ovelha070
(@ovelha070)
Posts: 7
Active Member
Topic starter
 

Olha eu novamente Edcronos.

Fui aplicar aquele código na minha planilha de trabalho e deu erro.
Vou mandar a planilha que vem para mim para vc dar uma olhada.

Alegria de pobre dura pouco...hehehe

https://drive.google.com/file/d/0BwMO_w ... sp=sharing

meu e-mail: [email protected]

 
Postado : 15/07/2014 9:08 am
 Edcronos
(@edcronos)
Posts: 1006
Noble Member
 

Sub Dividir_Coluna()
Dim cd As Long, d As Variant
s = InputBox("Digite quantas linhas deve ter cada coluna:", "Configuração", "20")

If (s <> "") Then
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
cd = 1: ld = 1
lf = Cells(Rows.Count, 1).End(xlUp).Row

For lo = 1 To lf
d = Cells(lo, 1).Value2
'Cells(lo, 1).Value2 = ""
Cells(ld, cd).Value2 = d
ld = ld + 1
If ld = s + 1 Then ld = 1: cd = cd + 1
Next
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
End If

End Sub

Somente é impossíveis até que alguém faça
A logica está presa na irracionalidade humana, e morta nos que se consideram donos da verdade.

"ALGUM MODERADOR ME EXPULSE DO FÓRUM POR FAVOR"

 
Postado : 15/07/2014 9:59 am
 ovelha070
(@ovelha070)
Posts: 7
Active Member
Topic starter
 

Sub Dividir_Coluna()
Dim cd As Long, d As Variant
s = InputBox("Digite quantas linhas deve ter cada coluna:", "Configuração", "20")

If (s <> "") Then
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
cd = 1: ld = 1
lf = Cells(Rows.Count, 1).End(xlUp).Row

For lo = 1 To lf
d = Cells(lo, 1).Value2
'Cells(lo, 1).Value2 = ""
Cells(ld, cd).Value2 = d
ld = ld + 1
If ld = s + 1 Then ld = 1: cd = cd + 1
Next
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
End If

End Sub

Eu coloquei esse código e na hora de digitar quantas linhas deve ter em cada coluna eu digitei 460. Aconteceu que ele dividiu somente até a linha 460 e ai parou, tentei alterar alguns atributos, mas sem sucesso.
coloquei aqui o exemplo do resultado que citei acima.

https://drive.google.com/file/d/0BwMO_wt6UQulaVA3RTdWNXVmbzQ/edit?usp=sharing

Já estou enchendo o saco, me desculpe, mas sou novo em VBA e Macros.

 
Postado : 15/07/2014 11:37 am
 Edcronos
(@edcronos)
Posts: 1006
Noble Member
 

não parou
apenas não apagou as linhas do original

troque
'Cells(lo, 1).Value2 = ""
por
Cells(lo, 1).Value2 = ""

o ' do inicio não deixa executar a linha de comando

Somente é impossíveis até que alguém faça
A logica está presa na irracionalidade humana, e morta nos que se consideram donos da verdade.

"ALGUM MODERADOR ME EXPULSE DO FÓRUM POR FAVOR"

 
Postado : 15/07/2014 11:56 am
 ovelha070
(@ovelha070)
Posts: 7
Active Member
Topic starter
 

Nem acredito que era apenas isso kkkkk...
Que Deus continue abençoando sua vida mano!

Obrigado!!!

 
Postado : 15/07/2014 12:27 pm
Forum Jump:
  Tópico Anterior
Próximo Tópico