Jump to content
Fórum Script Brasil
  • 0

TRANSPOR COLUNAS EM LINHAS


Question

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 to post
Share on other sites

Recommended Posts

  • 0

sim, e outra coisa é que são varias linhas e por isso uso uma macro para transpor cada uma em uma coluna diferente.

Teria como um único código transpor todas de uma vez só? Essa tabela é só um representativo do que estou transportando. As colunas possuem parâmetros diferentes image.thumb.png.64e7d24f2f6f907d4080cf37814b29b8.png 

Link to post
Share on other sites
  • 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 to post
Share on other 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 to post
Share on other 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 to post
Share on other 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 to post
Share on other sites
  • 0
Posted (edited)

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

Edited by luiza lopes
Link to post
Share on other 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 to post
Share on other sites

Join the conversation

You can post now and register later. If you have an account, sign in now to post with your account.

Guest
Answer this question...

×   Pasted as rich text.   Paste as plain text instead

  Only 75 emoji are allowed.

×   Your link has been automatically embedded.   Display as a link instead

×   Your previous content has been restored.   Clear editor

×   You cannot paste images directly. Upload or insert images from URL.



  • Forum Statistics

    • Total Topics
      148691
    • Total Posts
      644530
×
×
  • Create New...