แยกแถวกับ บริษัท หนึ่งแห่งในคอลัมน์และที่อยู่อีเมลหลายรายการในคอลัมน์อื่น [ซ้ำกัน]

ฉันมีข้อมูลใน Excel ที่มีลักษณะดังนี้:

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

ฉันมีข้อมูลนี้ประมาณ 25,000 แถว บริษัท บางแห่งอาจมี บริษัท 25k และที่อยู่อีเมล 40k ฉันต้องการทำให้ข้อมูลเป็นดังนี้:

Company1 email1
Company1 email2
Company1 email3
Company2 email1
etc.

บันทึกไฟล์ 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

มาโครนี้จะทำงาน:

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 และวางรหัสทางด้านขวา ดำเนินการแมโคร

คุณไม่สามารถทำได้โดยตรงใน Excel ตัวเลือกที่ดีที่สุดของคุณคือให้โปรแกรม / สคริปต์เล็ก ๆ ทำการแปลงให้คุณ ฉันเสนอให้คุณคำตอบที่ใช้ หลาม .

1. ดาวน์โหลดและติดตั้งงูหลามหากคุณยังไม่ได้ติดตั้งลงในคอมพิวเตอร์ของคุณ

   Python ปล่อย Python 2.7.10 | Python.org ( ลิงค์ตรง )

2. จาก Excel ให้บันทึกไฟล์ของคุณเป็น CSV
   หมายเหตุ: อาจมีตัวเลือก CSV มากกว่าหนึ่งตัวเลือกในกล่องโต้ตอบบันทึกเป็น ตรวจสอบให้แน่ใจที่จะเลือก CSV (คั่นด้วยจุลภาค) .
3. คัดลอกรหัสด้านล่างลงในแผ่นจดบันทึกและบันทึกเป็น convert.py. คุณจะต้องเลือก เอกสารทั้งหมด เพื่อให้ Notepad บันทึกด้วยนามสกุลไฟล์ที่ถูกต้อง
   จำไว้ว่าให้แทนที่ "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 เพื่อเรียกใช้และทำการแปลง

นี่คือแมโคร 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