none
Como Transpor linhas em uma coluna só ? RRS feed

  • Pergunta

  • Bom dia

    estou com um pequeno problema , a foto da tabela esta em no link

    http://fbcdn-sphotos-a-a.akamaihd.net/hphotos-ak-ash3/964171_4941833338907_531471738_o.jpg

    preciso que a todas as linhas fiquem em sequencia em uma coluna só 

    ex.

    sao 31 valor por linhas , tem que ter os 31 valores de cada linha em seguidos em uma coluna so contendo os valores em branco.

    Muito Obrigado pra quem ajudar .


    quinta-feira, 23 de maio de 2013 14:34

Respostas

  • Jeferson,

    melhorando um pouco o código acima, aí vai o código para escolher a forma de vetorização, por linhas ou por colunas:

    Option Base 1
    Sub VetorizarLinhas()
    '
    
    x = Range("B2:F11")     'Intervalo desejado
    
    Li = 15                 'Linha Inicial para Resultado
    Ci = 1                  'Linha Inicial para Resultado
    
    Dim y()
    ReDim y(1 To UBound(x, 1) * UBound(x, 2), 1)
    
    ii = 1
    For i = 1 To UBound(x, 1)
        For j = 1 To UBound(x, 2)
    
            y(ii, 1) = x(i, j)
            ii = ii + 1
        Next j
    Next i
    
    'Colando o Resultado
    Range(Cells(Li, Ci), Cells(Li + UBound(y) - 1, Ci)).Value = y
    
    End Sub
    
    
    Sub VetorizarColunas()
    '
    
    x = Range("B2:F11")     'Intervalo desejado
    
    Li = 15                 'Linha Inicial para Resultado
    Ci = 2                  'Linha Inicial para Resultado
    
    Dim y()
    ReDim y(1 To UBound(x, 1) * UBound(x, 2), 1)
    
    ii = 1
    For i = 1 To UBound(x, 2)
        For j = 1 To UBound(x, 1)
    
            y(ii, 1) = x(j, i)
            ii = ii + 1
        Next j
    Next i
    
    'Colando o Resultado
    Range(Cells(Li, Ci), Cells(Li + UBound(y) - 1, Ci)).Value = y
    
    End Sub
    

    Vlw.


    Filipe Magno

    quarta-feira, 5 de junho de 2013 00:29

Todas as Respostas

  • Selecione o intervalo D1:AH46 e pressione Ctrl+C para copiar a seleção. Em seguida, clique com o botão direito na célula A1, escolha 'Colar Especial' e na janela que aparecer, marque a caixa de seleção 'Transpor' e clique em 'OK'.

    Felipe Costa Gualberto - http://www.ambienteoffice.com.br

    quinta-feira, 23 de maio de 2013 21:47
    Moderador
  • nao da certo pois diz q nao é do mesmo tamanho , e todas as linhas tem q fica em seguencia em uma coluna só nao em varias , e tem q manter os espacos em branco
    quinta-feira, 30 de maio de 2013 20:53
  • Boa Noite Jeferson!

    Acho que o código abaixo faz o que você precisa:

    Option Base 1 Sub Vetorizar() ' x = Range("B2:F11") 'Intervalo com os dados desejados

    Dim y() ReDim y(1 To UBound(x, 1) * UBound(x, 2), 1) ii = 1 For i = 1 To UBound(x, 1) For j = 1 To UBound(x, 2) y(ii, 1) = x(i, j) ii = ii + 1 Next j Next i

    'Colando os dados na Coluna A (1) a partir da Linha 15 Range(Cells(15, 1), Cells(15 + UBound(y) - 1, 1)).Value = y End Sub

    Você precisa apenas definir o intervalo que possui os dados de entrada e a célula inicial para o intervalo de saída.

    Um abraço!


    Filipe Magno

    quinta-feira, 30 de maio de 2013 23:33
  • Jeferson,

    melhorando um pouco o código acima, aí vai o código para escolher a forma de vetorização, por linhas ou por colunas:

    Option Base 1
    Sub VetorizarLinhas()
    '
    
    x = Range("B2:F11")     'Intervalo desejado
    
    Li = 15                 'Linha Inicial para Resultado
    Ci = 1                  'Linha Inicial para Resultado
    
    Dim y()
    ReDim y(1 To UBound(x, 1) * UBound(x, 2), 1)
    
    ii = 1
    For i = 1 To UBound(x, 1)
        For j = 1 To UBound(x, 2)
    
            y(ii, 1) = x(i, j)
            ii = ii + 1
        Next j
    Next i
    
    'Colando o Resultado
    Range(Cells(Li, Ci), Cells(Li + UBound(y) - 1, Ci)).Value = y
    
    End Sub
    
    
    Sub VetorizarColunas()
    '
    
    x = Range("B2:F11")     'Intervalo desejado
    
    Li = 15                 'Linha Inicial para Resultado
    Ci = 2                  'Linha Inicial para Resultado
    
    Dim y()
    ReDim y(1 To UBound(x, 1) * UBound(x, 2), 1)
    
    ii = 1
    For i = 1 To UBound(x, 2)
        For j = 1 To UBound(x, 1)
    
            y(ii, 1) = x(j, i)
            ii = ii + 1
        Next j
    Next i
    
    'Colando o Resultado
    Range(Cells(Li, Ci), Cells(Li + UBound(y) - 1, Ci)).Value = y
    
    End Sub
    

    Vlw.


    Filipe Magno

    quarta-feira, 5 de junho de 2013 00:29