Dividir uma linha com uma empresa em uma coluna e vários endereços de e-mail em outras colunas [duplicada]

0

Eu tenho dados no Excel que se parecem com isso:

column1 column2 column3, column4, column5
Company1 email1 email2 email3
Company2 email1 email2
Company3 email1 email2 email3 email4 email5

Tenho cerca de 25 mil linhas desses dados, algumas talvez 25 mil empresas e 40 mil endereços de e-mail. Gostaria de tornar os dados parecidos com isto:

Company1 email1
Company1 email2
Company1 email3
Company2 email1
etc.
    
por user3734387 04.12.2015 / 08:08

4 respostas

2

Salve o arquivo csv e use awk (ferramenta linux ou cygwin):

awk -F, '{if (NR>1) {if (NF==1) {print $1} else {for (f=2; f<=NF; f++) print $1","$f}}}' ./myfile.csv >./mynewfile.csv

Explicação:

awk lê no arquivo linha por linha, ele divide cada linha em 'campos' (ou seja, colunas) usando a vírgula como delimitador ( -F ,), cada campo é chamado de $1 up. Ele pula a primeira linha (cabeçalhos) e, para cada linha, cria uma série de linhas onde cada campo está em uma linha separada precedida pelo primeiro campo. A saída é gravada de volta para um novo arquivo. Você pode abrir este novo arquivo no Excel.

    
por 04.12.2015 / 08:52
0

Esta macro fará o trabalho:

Public Sub createrows()
    Application.ScreenUpdating = False
    Dim wks As Worksheet
    Set wks = ActiveSheet
    firstrow = 2
    thecolumn = 3
    searchingrow = True
    therow = firstrow
    While searchingrow
        totalcolumns = wks.Cells(therow, Columns.Count).End(xlToLeft).Column
        For j = totalcolumns To thecolumn Step -1
            a = wks.Cells(therow, j)
            Rows(therow + 1).Insert shift:=xlShiftDown
            wks.Cells(therow + 1, 1) = wks.Cells(therow, 1)
            wks.Cells(therow + 1, 2) = wks.Cells(therow, j)
        Next j
        therow = therow + 1
        If wks.Cells(therow, 1) = "" Then searchingrow = False
    Wend
    wks.Range(Cells(1, thecolumn), Cells(therow, 1000)).Delete
    Application.ScreenUpdating = True
    themessage = MsgBox("Finished", vbInformation)
End Sub

Abra o VBA / Macro com ALT + F11, insira um novo módulo em ThisWorkbook e cole o código no lado direito. Execute a macro.

    
por 04.12.2015 / 10:22
0

Você não pode fazer isso diretamente no Excel. Sua melhor opção é ter um pequeno programa / script para fazer a conversão para você. Proponho-lhe uma resposta que use o Python .

  1. Faça o download e instale o python se você não o tiver instalado no seu computador.

    Python Release Python 2.7.10 | Python.org (Direct link)

  2. No Excel, salve seu arquivo como CSV.
    NB: Pode haver mais de uma opção CSV na caixa de diálogo Salvar como. Certifique-se de escolher CSV (delimitado por vírgulas) .
  3. Copie o código abaixo no bloco de notas e salve-o como convert.py . Você terá que escolher Todos os Arquivos para que o Bloco de Notas salve com a extensão de arquivo correta.
    Lembre-se de substituir os "c:/users/user/desktop/book1.csv" e "c:/users/user/desktop/book2.csv" pelos nomes dos arquivos de entrada e saída corretos, respectivamente. Além disso, você deve alterar todas as barras invertidas ( \ ) com barras ( / ).
infile = open("c:/users/user/desktop/book1.csv", "rb")
outfile = open("c:/users/user/desktop/book2.csv", "wb")
import csv
reader = csv.reader(infile)
writer = csv.writer(outfile)
reader.next() # skip header
writer.writerow(["Company", "Email"])
writer.writerows(((row[0], email) for row in reader \
                                  for email in row[1:] if email != ""))
outfile.close()
infile.close()
  1. Clique duas vezes no arquivo python para executá-lo e realizar a conversão.
por 04.12.2015 / 10:36
0

Aqui está outra macro do VBA que deve ser executada com relativa rapidez, como acontece no trabalho em arrays VBA, e não na planilha.

Assume que os dados de origem começam em A1 ou A2; a região de dados é contígua e os emails de cada empresa são contíguos (de forma que a primeira célula em branco em uma linha seja após o último endereço de email). O código exigiria pequenas modificações se qualquer uma dessas suposições não for verdadeira.

Há também uma suposição de que não há rótulos de coluna, com instruções nos comentários do código sobre como compensar isso.

Option Explicit
Sub RowsToColumns()
    Dim vSrc As Variant
    Dim COL As Collection
    Dim wsSrc As Worksheet, wsRes As Worksheet, rRes As Range
    Dim S(0 To 1) As String
    Dim I As Long, J As Long

'Define source and result worksheets and ranges
'Alter as necessary
Set wsSrc = Worksheets("sheet3")
Set wsRes = Worksheets("sheet4")
    Set rRes = wsRes.Cells(1, 1)

'Read source data into array
' This method assumes data starts in A2, and is
'  contained in a contiguous array.
'But other methods could be used
vSrc = wsSrc.Cells(2, 1).CurrentRegion

'Collect the results into Collection object
'Assumes no header row, if there is, then start
'  with for I = 2 to ...
Set COL = New Collection
For I = 1 To UBound(vSrc, 1) 'the rows
    For J = 2 To UBound(vSrc, 2) 'the columns
        S(0) = vSrc(I, 1) 'company name
        S(1) = vSrc(I, J) 'email
        If S(1) <> "" Then
            COL.Add S
        Else
            Exit For 'assumes first blank in email list is end of list
        End If
    Next J
Next I

'Create results array
ReDim vres(1 To COL.Count, 1 To 2)
For I = 1 To COL.Count
    With COL(I)
        vres(I, 1) = COL(I)(0)
        vres(I, 2) = COL(I)(1)
    End With
Next I

'Write the results to worksheet
Set rRes = rRes.Resize(rowsize:=UBound(vres, 1), columnsize:=UBound(vres, 2))
With rRes
    .EntireColumn.Clear
    .Value = vres
    .EntireColumn.AutoFit
End With

End Sub
por 07.12.2015 / 23:04