☰

将一行拆分为一列，其中一家公司在其他列中显示多个电子邮件地址

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

我有大约 25000 行数据，大概有 25000 个公司和 40000 个电子邮件地址。我想让数据看起来像这样：

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

使用 ALT+F11 打开 VBA/Macro，在下方插入一个新模块本工作簿并将代码粘贴到右侧。执行宏。

答案3

您无法直接在 Excel 中执行此操作。最好的选择是让一个小程序/脚本为您进行转换。我向您推荐一个答案，它使用Python。

  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

相关内容