locked
Linhas virando Colunas RRS feed

  • Pergunta

  • Olá.

    Eu possuo um arquivo que exportei do Lotus Notes.

    Ele não é um formato válido para Excel, mas de qualquer forma consegui abrí-lo no meu excel.

    O problemá é que os dados estão todos na vertical da seguinte forma:

     

    [símbolo]

    Nome da Coluna: Dados da Coluna

    Nome da Coluna: Dados da Coluna

    Nome da Coluna: Dados da Coluna

    Nome da Coluna: Dados da Coluna

    Nome da Coluna: Dados da Coluna

    Nome da Coluna: Dados da Coluna

    Nome da Coluna: Dados da Coluna

    Nome da Coluna: Dados da Coluna

    Nome da Coluna: Dados da Coluna

    Nome da Coluna: Dados da Coluna

    Nome da Coluna: Dados da Coluna

    Nome da Coluna: Dados da Coluna

    [Linha em Branco]

    [Mesmo símbolo do início]

     

    O que eu preciso é que os dados fiquem na forma comum, ou seja, separados por colunas lado a lado.

    Alguém sabe como faço isso? Eu tenho aproximadamente 8000 contatos desta forma que preciso mudar para que assim eu posso importá los no meu SharePoint.

    Valeu ai


    Leandro Duarte
    segunda-feira, 18 de abril de 2011 20:21

Respostas

  • Bom dia..

    Primeiro crie uma ABA na planilha que chamaremos de Plan1

    No editor do VBA crie um módulo e coloque o código abaixo:

    Sub Transpor()

    Plan1.Select

    Do

        If Plan1.Range("A4") = "" Then
        Plan2.Select
        MsgBox ("Dados Extraídos com Sucesso !! "), vbOKOnly + 64
        Call Contador
        Call Tirar_Nomes
        Exit Sub
        End If
       
       
        If Plan2.Range("A2") = "" Then
        Plan1.Range("A1").Select
        Range(Selection, Selection.End(xlDown)).Select
        Selection.Copy
        Sheets("Plan1").Select
        Range("A2").Select
        Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _
            xlNone, SkipBlanks:=False, Transpose:=True
        Sheets("PI_Contatos_ST").Select
    ' Exclui os valores
        Range("A1").Select
        Range(Selection, Selection.End(xlDown)).Select
        Range(Selection, Selection.End(xlDown)).Select
        Application.CutCopyMode = False
        Selection.EntireRow.Delete

    '-------------------------------------------------------------------------------------------------
       
    ' Copia os valores
        ElseIf Plan2.Range("A3") = "" Then
        Plan1.Range("A1").Select
        Range(Selection, Selection.End(xlDown)).Select
        Selection.Copy
        Sheets("Plan1").Select
        Range("A3").Select
        Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _
            xlNone, SkipBlanks:=False, Transpose:=True
        Sheets("PI_Contatos_ST").Select
    ' Exclui os valores
        Range("A1").Select
        Range(Selection, Selection.End(xlDown)).Select
        Range(Selection, Selection.End(xlDown)).Select
        Application.CutCopyMode = False
        Selection.EntireRow.Delete

    '-------------------------------------------------------------------------------------------------
     
    ' Copia os valores
        ElseIf Plan2.Range("A2") <> "" And Plan2.Range("A3") <> "" Then
        Plan1.Range("A1").Select
        Range(Selection, Selection.End(xlDown)).Select
        Selection.Copy
        Sheets("Plan1").Select
        Range("A2").Select
        Selection.End(xlDown).Select
        ActiveCell.Offset(1, 0).Range("A1").Select
        Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _
            xlNone, SkipBlanks:=False, Transpose:=True
        Sheets("PI_Contatos_ST").Select
    ' Exclui os valores
        Range("A1").Select
        Range(Selection, Selection.End(xlDown)).Select
        Range(Selection, Selection.End(xlDown)).Select
        Application.CutCopyMode = False
        Selection.EntireRow.Delete

     End If

         
        Loop
       
       
       
       
     End Sub
     Crie mais um módulo e coloque os seguintes códigos:

    Sub Contador()

    numeroRegistros = Range("A1").End(xlDown).Row
    MsgBox "Foram Encontrados : " & numeroRegistros & " registros", vbOKOnly + 64


    End Sub

     

     

    Sub Tirar_Nomes()
     

     
          Cells.Replace What:="FolderOptions: ", Replacement:="", LookAt:=xlPart, _
            SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
            ReplaceFormat:=False
           
                  Cells.Replace What:="TimeCreated:  ", Replacement:="", LookAt:=xlPart, _
            SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
            ReplaceFormat:=False
           
                Cells.Replace What:="Subject: ", Replacement:="", LookAt:=xlPart, _
            SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
            ReplaceFormat:=False
     
                Cells.Replace What:="txt_empresa:  ", Replacement:="", LookAt:=xlPart, _
            SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
            ReplaceFormat:=False
           
                  Cells.Replace What:="txt_cargo:  ", Replacement:="", LookAt:=xlPart, _
            SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
            ReplaceFormat:=False
     
                Cells.Replace What:="txt_setor:  ", Replacement:="", LookAt:=xlPart, _
            SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
            ReplaceFormat:=False
           
                  Cells.Replace What:="kwd_tipo:  ", Replacement:="", LookAt:=xlPart, _
            SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
            ReplaceFormat:=False
     
                Cells.Replace What:="txt_end:  ", Replacement:="", LookAt:=xlPart, _
            SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
            ReplaceFormat:=False
           
                  Cells.Replace What:="txt_fone:  ", Replacement:="", LookAt:=xlPart, _
            SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
            ReplaceFormat:=False
     
                Cells.Replace What:="txt_mail:  ", Replacement:="", LookAt:=xlPart, _
            SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
            ReplaceFormat:=False
           
                  Cells.Replace What:="txt_fax:  ", Replacement:="", LookAt:=xlPart, _
            SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
            ReplaceFormat:=False
     
                Cells.Replace What:="txt_observa:  ", Replacement:="", LookAt:=xlPart, _
            SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
            ReplaceFormat:=False
           
                Cells.Replace What:="SavedOnce:  ", Replacement:="", LookAt:=xlPart, _
            SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
            ReplaceFormat:=False
           
                  Cells.Replace What:="orgao:  ", Replacement:="", LookAt:=xlPart, _
            SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
            ReplaceFormat:=False
     
                Cells.Replace What:="$UpdatedBy:  ", Replacement:="", LookAt:=xlPart, _
            SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
            ReplaceFormat:=False
           
                        Cells.Replace What:="$Revisions:  ", Replacement:="", LookAt:=xlPart, _
            SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
            ReplaceFormat:=False
    End Sub

     

     É isso ai.. espero ter ajudado.

    Se resolveu seu problema não esqueça de marcar como resolvido.

    Abraço e bom dia.

    • Sugerido como Resposta Allvinho quarta-feira, 20 de abril de 2011 19:38
    • Marcado como Resposta TI DEV segunda-feira, 25 de abril de 2011 14:10
    quarta-feira, 20 de abril de 2011 19:38

Todas as Respostas

  • Selecione todo o conteúdo, em outra planilha com botão direito do mouse, cole especial e marque o ítem TRANSPOR.
    segunda-feira, 18 de abril de 2011 21:02
  • E ai.

    Bom sei que se eu fizer apenas com um bloco de dados na vertical e fazer o procedimento de Transpor da certo, mas no meu caso eu tenho muitas informação na vertical separadas por um espaço, então não consigo fazer a transposição delas todas.

    Teria que ser de uma outra forma.

    Alguém sabe como faço isso?

    Abaixo segue o exemplo do meus dados:

    [símbolo]

    Nome da Coluna: Dados da Coluna

    Nome da Coluna: Dados da Coluna

    Nome da Coluna: Dados da Coluna

    Nome da Coluna: Dados da Coluna

    Nome da Coluna: Dados da Coluna

    Nome da Coluna: Dados da Coluna

    Nome da Coluna: Dados da Coluna

    Nome da Coluna: Dados da Coluna

    Nome da Coluna: Dados da Coluna

    Nome da Coluna: Dados da Coluna

    Nome da Coluna: Dados da Coluna

    Nome da Coluna: Dados da Coluna

    [Linha em Branco]

    [símbolo]

    Nome da Coluna: Dados da Coluna

    Nome da Coluna: Dados da Coluna

    Nome da Coluna: Dados da Coluna

    Nome da Coluna: Dados da Coluna

    Nome da Coluna: Dados da Coluna

    Nome da Coluna: Dados da Coluna

    Nome da Coluna: Dados da Coluna

    Nome da Coluna: Dados da Coluna

    Nome da Coluna: Dados da Coluna

    Nome da Coluna: Dados da Coluna

    Nome da Coluna: Dados da Coluna

    Nome da Coluna: Dados da Coluna

    [Linha em Branco]

     

    Abraços


    Leandro Duarte
    terça-feira, 19 de abril de 2011 12:38
  • Daria pra fazer uma macro pra verificar célula a célula, mas se vc selecionar tudo e classificar poderá retirar os espaços e outras sujeiras que tiver, ai faz o "transpor"
    terça-feira, 19 de abril de 2011 18:43
  • O caso do Marcelo é bem útil, mais caso queira fazer com Macro, segue abaixo um código.

     

    Sub Excluir_Valores()

    'Aqui você define o seu intervalo de dados
    For A = 13 To 102
    'Onde tem o "d", você substitui pela coluna de onde você quer tirar os valores, ou seja, linhas em branco
    'Adapte os valores que você quer que a Macro exclua.
    If Range("d" & A).Value = "" Or Range("d" & A).Value = 0 Then
    Range("d" & A).Select
    'Exclui a linha
    Selection.EntireRow.Delete
    Else
    Range("d" & A).Select
    Selection.EntireRow.Hidden = False
    End If
    'Verifica a próxima linha
    Next A

    End Sub

     

    Abraço

    terça-feira, 19 de abril de 2011 18:59
  • Hum.

    Mas no caso, para tirar os espaços seria as linhas em branco?

    E as linhas que contém símbolo tambem poderiam ser excluídas?

    Fiz um teste de pegar um determinado grupo de dados na vertical e transpolos para a horizontal, deu certo, e depois fiz outro teste onde eu colava na proxima coluna os dados de baixo do grupo selecionada e quando os copiava e manda colar como especial no modo transpor ficava do jeito que preciso, mas como tem mais de 4000 grupos de dados não daria para fazer isto.

    Abs


    Leandro Duarte
    terça-feira, 19 de abril de 2011 18:59
  • Teria como você me mandar a planilha por e-mail.

    Visualizando o arquivo fica mais fácil entender e te ajudar.

     

    alvaro.horta@yamana.com

     

    Abraço

    terça-feira, 19 de abril de 2011 19:05
  • Te mandei a planilha.

    Valeu ai


    Leandro Duarte
    terça-feira, 19 de abril de 2011 19:22
  • Bom dia..

    Primeiro crie uma ABA na planilha que chamaremos de Plan1

    No editor do VBA crie um módulo e coloque o código abaixo:

    Sub Transpor()

    Plan1.Select

    Do

        If Plan1.Range("A4") = "" Then
        Plan2.Select
        MsgBox ("Dados Extraídos com Sucesso !! "), vbOKOnly + 64
        Call Contador
        Call Tirar_Nomes
        Exit Sub
        End If
       
       
        If Plan2.Range("A2") = "" Then
        Plan1.Range("A1").Select
        Range(Selection, Selection.End(xlDown)).Select
        Selection.Copy
        Sheets("Plan1").Select
        Range("A2").Select
        Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _
            xlNone, SkipBlanks:=False, Transpose:=True
        Sheets("PI_Contatos_ST").Select
    ' Exclui os valores
        Range("A1").Select
        Range(Selection, Selection.End(xlDown)).Select
        Range(Selection, Selection.End(xlDown)).Select
        Application.CutCopyMode = False
        Selection.EntireRow.Delete

    '-------------------------------------------------------------------------------------------------
       
    ' Copia os valores
        ElseIf Plan2.Range("A3") = "" Then
        Plan1.Range("A1").Select
        Range(Selection, Selection.End(xlDown)).Select
        Selection.Copy
        Sheets("Plan1").Select
        Range("A3").Select
        Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _
            xlNone, SkipBlanks:=False, Transpose:=True
        Sheets("PI_Contatos_ST").Select
    ' Exclui os valores
        Range("A1").Select
        Range(Selection, Selection.End(xlDown)).Select
        Range(Selection, Selection.End(xlDown)).Select
        Application.CutCopyMode = False
        Selection.EntireRow.Delete

    '-------------------------------------------------------------------------------------------------
     
    ' Copia os valores
        ElseIf Plan2.Range("A2") <> "" And Plan2.Range("A3") <> "" Then
        Plan1.Range("A1").Select
        Range(Selection, Selection.End(xlDown)).Select
        Selection.Copy
        Sheets("Plan1").Select
        Range("A2").Select
        Selection.End(xlDown).Select
        ActiveCell.Offset(1, 0).Range("A1").Select
        Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _
            xlNone, SkipBlanks:=False, Transpose:=True
        Sheets("PI_Contatos_ST").Select
    ' Exclui os valores
        Range("A1").Select
        Range(Selection, Selection.End(xlDown)).Select
        Range(Selection, Selection.End(xlDown)).Select
        Application.CutCopyMode = False
        Selection.EntireRow.Delete

     End If

         
        Loop
       
       
       
       
     End Sub
     Crie mais um módulo e coloque os seguintes códigos:

    Sub Contador()

    numeroRegistros = Range("A1").End(xlDown).Row
    MsgBox "Foram Encontrados : " & numeroRegistros & " registros", vbOKOnly + 64


    End Sub

     

     

    Sub Tirar_Nomes()
     

     
          Cells.Replace What:="FolderOptions: ", Replacement:="", LookAt:=xlPart, _
            SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
            ReplaceFormat:=False
           
                  Cells.Replace What:="TimeCreated:  ", Replacement:="", LookAt:=xlPart, _
            SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
            ReplaceFormat:=False
           
                Cells.Replace What:="Subject: ", Replacement:="", LookAt:=xlPart, _
            SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
            ReplaceFormat:=False
     
                Cells.Replace What:="txt_empresa:  ", Replacement:="", LookAt:=xlPart, _
            SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
            ReplaceFormat:=False
           
                  Cells.Replace What:="txt_cargo:  ", Replacement:="", LookAt:=xlPart, _
            SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
            ReplaceFormat:=False
     
                Cells.Replace What:="txt_setor:  ", Replacement:="", LookAt:=xlPart, _
            SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
            ReplaceFormat:=False
           
                  Cells.Replace What:="kwd_tipo:  ", Replacement:="", LookAt:=xlPart, _
            SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
            ReplaceFormat:=False
     
                Cells.Replace What:="txt_end:  ", Replacement:="", LookAt:=xlPart, _
            SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
            ReplaceFormat:=False
           
                  Cells.Replace What:="txt_fone:  ", Replacement:="", LookAt:=xlPart, _
            SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
            ReplaceFormat:=False
     
                Cells.Replace What:="txt_mail:  ", Replacement:="", LookAt:=xlPart, _
            SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
            ReplaceFormat:=False
           
                  Cells.Replace What:="txt_fax:  ", Replacement:="", LookAt:=xlPart, _
            SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
            ReplaceFormat:=False
     
                Cells.Replace What:="txt_observa:  ", Replacement:="", LookAt:=xlPart, _
            SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
            ReplaceFormat:=False
           
                Cells.Replace What:="SavedOnce:  ", Replacement:="", LookAt:=xlPart, _
            SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
            ReplaceFormat:=False
           
                  Cells.Replace What:="orgao:  ", Replacement:="", LookAt:=xlPart, _
            SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
            ReplaceFormat:=False
     
                Cells.Replace What:="$UpdatedBy:  ", Replacement:="", LookAt:=xlPart, _
            SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
            ReplaceFormat:=False
           
                        Cells.Replace What:="$Revisions:  ", Replacement:="", LookAt:=xlPart, _
            SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
            ReplaceFormat:=False
    End Sub

     

     É isso ai.. espero ter ajudado.

    Se resolveu seu problema não esqueça de marcar como resolvido.

    Abraço e bom dia.

    • Sugerido como Resposta Allvinho quarta-feira, 20 de abril de 2011 19:38
    • Marcado como Resposta TI DEV segunda-feira, 25 de abril de 2011 14:10
    quarta-feira, 20 de abril de 2011 19:38