☰

Dividir una fila con una empresa en una columna y varias direcciones de correo electrónico en otras columnas

tag-icon • tag-icon microsoft-excel
Dividir una fila con una empresa en una columna y varias direcciones de correo electrónico en otras columnas

Tengo datos en Excel que se ven así:

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

Tengo alrededor de 25.000 filas de estos datos, algunas quizás 25.000 empresas y 40.000 direcciones de correo electrónico. Me gustaría que los datos se vieran así:

Company1 email1
Company1 email2
Company1 email3
Company2 email1
etc.

Respuesta1

Guarde el archivo csv y luego use awk(herramienta Linux o 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

Explicación:

awklee el archivo línea por línea, divide cada línea en 'campos' (es decir, columnas) usando la coma como delimitador ( -F,), se llama a cada campo $1. Se salta la primera línea (encabezados), luego, para cada línea, crea una serie de líneas donde cada campo está en una línea separada precedida por el primer campo. La salida se vuelve a escribir en un archivo nuevo. Puede abrir este nuevo archivo en Excel.

Respuesta2

Esta macro hará el trabajo:

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 VBA/Macro con ALT+F11, inserte un nuevo módulo enEste libro de trabajoy pega el código en el lado derecho. Ejecute la macro.

Respuesta3

No puede hacer esto directamente en Excel. Su mejor opción es que un pequeño programa/script haga la conversión por usted. Te propongo una respuesta que utilizaPitón.

  1. Descargue e instale Python si aún no lo tiene instalado en su computadora.

    Lanzamiento de Python Python 2.7.10 | Python.org (Enlace directo)

  2. Desde Excel, guarde su archivo como CSV.
    NÓTESE BIEN:Puede haber más de una opción CSV en el cuadro de diálogo Guardar como. Asegúrate de elegirCSV (delimitado por comas).
  3. Copie el siguiente código en el bloc de notas y guárdelo como convert.py. tendrás que elegirTodos los archivospara que el Bloc de notas se guarde con la extensión de archivo correcta.
    Recuerde reemplazar "c:/users/user/desktop/book1.csv"y "c:/users/user/desktop/book2.csv"con los nombres correctos de los archivos de entrada y salida, respectivamente. Además, debe cambiar todas las barras invertidas ( \) por barras diagonales ( /).
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. Haga doble clic en el archivo Python para ejecutarlo y realizar la conversión.

Respuesta4

Aquí hay otra macro de VBA que debería ejecutarse relativamente rápido, ya que realiza el trabajo en matrices de VBA, en lugar de en la hoja de trabajo.

Se supone que los datos de origen comienzan en A1 o A2; la región de datos es contigua y los correos electrónicos de cada empresa son contiguos (de modo que la primera celda en blanco de una fila está después de la última dirección de correo electrónico). El código requeriría modificaciones menores si alguna de esas suposiciones no fuera cierta.

También se supone que no hay etiquetas de columna, con instrucciones en los comentarios del código sobre cómo compensar eso.

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

información relacionada