Ir para conteúdo
Fórum Script Brasil
  • 0

TRANSPOR COLUNAS EM LINHAS


luiza lopes

Pergunta

Olá,

Eu uso essa macro para transpor linhas em colunas, mas vejo que com a adição de mais linhas ela fica cada vez mais lenta. Alguém teria uma solução para isso? De modo que a macro pegasse somente as informações das linhas mais atuais? 

<> 

Sub TransporDados1()
    
    'Declarações

    Dim Arr() As Variant
    Dim LastRow As Variant, j As Long, linha As Long, coluna As Long
    Dim ws1 As Worksheet, ws2 As Worksheet
    Application.ScreenUpdating = False
    
    'Declara a planilha com os dados
    Set ws1 = ThisWorkbook.Sheets("BD")
    Set ws2 = ThisWorkbook.Sheets("Análise de Dados")
    'Em ws1:
    With ws1
        'ÚltimaLinha
        LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
        
        'Array
        Arr() = .Range("B2:B" & LastRow).Value2
              
        linha = 2
        coluna = 1
        
        'Loop em cada elemento da Array
        For j = LBound(Arr) To UBound(Arr)
           ws2.Cells(linha, coluna) = Arr(j, 1)
           coluna = coluna + 1
           
           'Quando preencher 9 células, passa para próxima linha e zera contador de coluna
           If coluna = 11 Then
            linha = linha + 1
            coluna = 1
           End If
        
        Next j
        
    End With
        Application.ScreenUpdating = True
    
    'Call timer2
End Sub


 

Link para o comentário
Compartilhar em outros sites

Posts Recomendados

  • 0

Vou testar ainda! É que eu tinha outra dúvida também, de como juntar as três macros que eu uso para transpor dados em uma. Você acha que teria como?

A tabela que eu uso é essa aqui:

image.png.9aaeedfd272c57fc94f20f34a37b2409.png

e cada coluna em branco eu uso uma macro para transpor cada linha individual em uma coluna. O código é o mesmo que enviei 

 

Link para o comentário
Compartilhar em outros sites

  • 0

Eu fiz uma planilha com a mesma ideia que você mandou na foto.

Foi acrescentando na linha 1 a planilha destino para estar "pre-definido" o destino para onde vai levar as informações

https://drive.google.com/open?id=1GUm6juULIhsBcn0loHM7ABsaAq9lzD-P

Sub cmdTranporValores()
'Criar variaveis
Dim Tabela As String 'Noma da tabla que vai ser levadas as informações
Dim nTabelas As Long 'Quantidade de tabela para transpor
Dim uLinha As Long 'Última linha
Dim uColuna As Long 'Última coluna
Dim y As Long 'Valor para coluna

'Identificar
uColuna = Sheets("Dados").Cells(1, Columns.Count).End(xlToLeft).Column
nTabelas = uColuna / 2
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual

'Loop para passsar de colunas
For y = 1 To uColuna Step 2

    Tabela = Sheets("Dados").Cells(1, y + 1).Value
    uLinha = Sheets("Dados").Cells(Rows.Count, y).End(xlUp).Row
    
    Sheets("Dados").Select
    Sheets("Dados").Range(Cells(2, y), Cells(uLinha, y + 1)).Select
    Selection.Copy
    Sheets(Tabela).Select
    Range("A1").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=True
    Sheets("Dados").Select
Next y

Application.ScreenUpdating = False
Application.Calculation = xlCalculationAutomatic

End Sub

 

Link para o comentário
Compartilhar em outros sites

  • 0

Oii, então o código criado  ficou mtu bom! Atende quase tudo o que eu preciso. Vou tentar te explicar melhor o que acontece com a tabela usando valores diferentes. Vou mandar os prints aqui. As duas figuras são em abas diferentes. Antes eu usei "Nome do Produto" como exemplo, agora acho que com esse exemplo ficou  mais claro. Obrigada desde jaaa

image.thumb.png.77b2eda75340fc76a97266fcbc155bff.pngimage.png.5c5bad2271d59749f078d5dd464e0f65.png

Oii, então o código criado  ficou mtu bom! Atende quase tudo o que eu preciso. Vou tentar te explicar melhor o que acontece com a tabela usando valores diferentes. Vou mandar os prints aqui. As duas figuras são em abas diferentes. Antes eu usei "Nome do Produto" como exemplo, agora acho que com esse exemplo ficou  mais claro. Obrigada desde jaaa. Creio que só falte adicionar um loop das informações e colocar todas na mesma aba.

image.thumb.png.77b2eda75340fc76a97266fcbc155bff.pngimage.png.5c5bad2271d59749f078d5dd464e0f65.png

Link para o comentário
Compartilhar em outros sites

  • 0

Os valores que nunca mudam são os da coluna 1, 3 e 5. A tabela original seria essa e funcionaria de modo que cada vez uma pessoa diferente iria preencher os dados com valores diferentes. E agora eu preciso transpor esses dados para colunas diferentes porem na mesma aba. 

image.png.e478f8f59cb5313b268149ba158e9426.png

Me avise se ainda não ficou claro a ideia, por favor! Você está me ajudando mtu

 

Link para o comentário
Compartilhar em outros sites

  • 0

Claro! vou te mandar a tabela sem preencher que fica mais claro:

image.png.2dfaae577514c236d3ab9731bf03dd55.png

Essa é a tabela, o esquema é cada pessoa vai preencher ela de modo diferente e preciso transpor essas informações para outra aba. As informações que quero transpor são aquelas que as pessoas vão preencher ( espaço em branco).

Veja se ficou mais claro agora!

image.thumb.png.d2a9ced165eb693642146ae50b3ae70f.png

E as informações tem que ficar assim na outra aba @Alyson Ronnan Martins

Editado por luiza lopes
Link para o comentário
Compartilhar em outros sites

  • 0

Eu fiz um tabela fictíca com valores mais ou menos que ficaram na foto.

Sub cmdImportarTexto()
Dim uLinha As Long 'Última linha

Dim lLista As Long 'Linha nova na tabela Lista
Dim cLista As Long 'Coluna nova na tabela lista
Dim yLista As Long 'Coluna pesquinsando a lista

Dim g As Long 'Grupo do produto
Dim x As Long 'Linha
Dim y As Long 'Coluna

Dim txtCampo
Dim txtValor

Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual

uLinha = Sheets("Dados").Cells(Rows.Count, "A").End(xlUp).Row

'Loop pulando de 7 em 7 linha começando na linha 1 até a ultima linha
For g = 1 To uLinha Step 7

    'Ultima linha da lista
    lLista = Sheets("Lista").Cells(Rows.Count, "A").End(xlUp).Row + 1

    'Loop pulando de 2 em 2 começando na coluna 2 até 6
    For y = 2 To 6 Step 2
        'Loop para passar pelas linhas
        For x = g To g + 6 Step 1
            txtCampo = Sheets("Dados").Cells(x, y - 1).Value
            txtValor = Sheets("Dados").Cells(x, y).Value
            
            'Procurar a coluna para colocar o valor
            For yLista = 1 To 21 Step 1
                If Sheets("Lista").Cells(1, yLista).Value = txtCampo Then
                    cLista = yLista
                    yLista = 22 'Parar o for
                    
                End If
            Next yLista
            
            'Cadastrar o valor na tabela nova
            Sheets("Lista").Cells(lLista, cLista).Value = txtValor
            
        Next
    Next y
Next g

Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic

End Sub

Link da planilha:

https://drive.google.com/open?id=1R3TqwBk4ylki9L1B0uhhi4cK3DsnTlbS

Link para o comentário
Compartilhar em outros sites

Participe da discussão

Você pode postar agora e se registrar depois. Se você já tem uma conta, acesse agora para postar com sua conta.

Visitante
Responder esta pergunta...

×   Você colou conteúdo com formatação.   Remover formatação

  Apenas 75 emoticons são permitidos.

×   Seu link foi incorporado automaticamente.   Exibir como um link em vez disso

×   Seu conteúdo anterior foi restaurado.   Limpar Editor

×   Você não pode colar imagens diretamente. Carregar ou inserir imagens do URL.



  • Estatísticas dos Fóruns

    • Tópicos
      152k
    • Posts
      651,7k
×
×
  • Criar Novo...