☰

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

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

У меня есть данные в 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.

решение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.

решение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, вставьте новый модуль подЭта рабочая книгаи вставьте код справа. Выполните макрос.

решение3

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

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

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

  2. Сохраните файл Excel как CSV.
    Примечание:В диалоговом окне «Сохранить как» может быть несколько вариантов 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()
  1. Дважды щелкните файл Python, чтобы запустить его и выполнить преобразование.

решение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

Связанный контент