Разделение строки с одной компанией в столбце и несколькими адресами электронной почты в других столбцах

Question

У меня есть данные в Excel, которые выглядят так:

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

У меня около 25 тыс. Строк этих данных, может быть, 25 тыс. Компаний и 40 тыс. Адресов электронной почты. Я хотел бы, чтобы данные выглядели так:

Company1 email1
Company1 email2
Company1 email3
Company2 email1
etc.

Answer 1

Сохраните файл csv и затем используйте awk (инструмент linux или 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

Объяснение:

awk читает файл построчно, разбивая каждую строку на «поля» (т.е. столбцы), используя запятую в качестве разделителя (-F ,), каждое поле называется $1 вверх. Он пропускает первую строку (заголовки), затем для каждой строки создает серию строк, где каждое поле находится на отдельной строке, которой предшествует первое поле. Вывод записывается обратно в новый файл. Вы можете открыть этот новый файл в Excel.

Answer 2

Этот макрос сделает работу:

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

Откройте VBA/Macro с помощью ALT+F11, вставьте новый модуль в ThisWorkbook и вставьте код с правой стороны. Выполнить макрос.

Answer 3

Вы не можете сделать это прямо в Excel. Лучше всего, чтобы небольшая программа / скрипт выполняла преобразование за вас. Я предлагаю вам ответ, который использует Python.

1. Загрузите и установите Python, если он еще не установлен на вашем компьютере.

   Python Release Python 2.7.10 | Python.org (Прямая ссылка)

2. В Excel сохраните файл в формате CSV.
   NB. В диалоговом окне «Сохранить как» может быть несколько параметров CSV. Убедитесь, что выбрали CSV (запятая).
3. Скопируйте приведенный ниже код в блокнот и сохраните его как convert.py . Вам нужно будет выбрать Все файлы, чтобы Блокнот сохранял их с правильным расширением.
   Не забудьте заменить "c:/users/user/desktop/book1.csv" и "c:/users/user/desktop/book2.csv" на правильные имена входных и выходных файлов соответственно. Кроме того, вы должны изменить все обратные косые черты (\) с косыми чертами (/).

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()

4. Дважды щелкните файл Python, чтобы запустить его и выполнить преобразование.

Answer 4

Вот еще один макрос VBA, который должен выполняться относительно быстро, поскольку он выполняет работу в массивах VBA, а не на листе.

Предполагается, что исходные данные начинаются с A1 или A2; область данных является непрерывной, а электронные письма для каждой компании являются смежными (так что первая пустая ячейка в строке находится после последнего адреса электронной почты). Код потребует незначительных изменений, если любое из этих предположений не соответствует действительности.

Существует также предположение, что в комментариях к коду отсутствуют метки столбцов с инструкциями о том, как это компенсировать.

---

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

---