☰

Aufteilen einer Zeile mit einem Unternehmen in einer Spalte und mehreren E-Mail-Adressen in anderen Spalten

tag-icon • tag-icon microsoft-excel
Aufteilen einer Zeile mit einem Unternehmen in einer Spalte und mehreren E-Mail-Adressen in anderen Spalten

Ich habe Daten in Excel, die so aussehen:

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

Ich habe etwa 25.000 Zeilen dieser Daten, darunter vielleicht 25.000 Unternehmen und 40.000 E-Mail-Adressen. Ich möchte, dass die Daten folgendermaßen aussehen:

Company1 email1
Company1 email2
Company1 email3
Company2 email1
etc.

Antwort1

Speichern Sie die Datei im CSV-Format und verwenden Sie dann awk(Linux- oder Cygwin-Tool):

awk -F, '{if (NR>1) {if (NF==1) {print $1} else {for (f=2; f<=NF; f++) print $1","$f}}}' ./myfile.csv >./mynewfile.csv

Erläuterung:

awkliest die Datei zeilenweise ein, teilt jede Zeile in „Felder“ (also Spalten) auf und verwendet dabei Kommas als Trennzeichen ( -F,). Jedes Feld wird aufgerufen $1. Die erste Zeile (Kopfzeile) wird übersprungen, dann wird für jede Zeile eine Reihe von Zeilen erstellt, wobei jedes Feld in einer separaten Zeile steht, der das erste Feld vorangestellt ist. Die Ausgabe wird in eine neue Datei zurückgeschrieben. Diese neue Datei können Sie in Excel öffnen.

Antwort2

Dieses Makro erledigt die Arbeit:

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

Öffnen Sie VBA/Macro mit ALT+F11, fügen Sie ein neues Modul ein unterDiesesArbeitsbuchund fügen Sie den Code auf der rechten Seite ein. Führen Sie das Makro aus.

Antwort3

Sie können dies nicht direkt in Excel tun. Ihre beste Option ist, ein kleines Programm/Skript die Konvertierung für Sie durchführen zu lassen. Ich schlage Ihnen eine Antwort vor, die verwendetPython.

  1. Laden Sie Python herunter und installieren Sie es, falls es noch nicht auf Ihrem Computer installiert ist.

    Python-Version Python 2.7.10 | Python.org (Direkte Verbindung)

  2. Speichern Sie Ihre Datei in Excel als CSV.
    Hinweis:Im Dialogfeld Speichern unter können mehrere CSV-Optionen vorhanden sein. Wählen Sie unbedingtCSV (durch Komma getrennt).
  3. Kopieren Sie den untenstehenden Code in den Editor und speichern Sie ihn unter convert.py. Sie müssen wählenAlle Dateiendamit Notepad mit der richtigen Dateierweiterung speichert. Denken Sie daran , und durch die richtigen Eingabe- bzw. Ausgabedateinamen
    zu ersetzen . Außerdem sollten Sie alle Backslashes ( ) durch Schrägstriche ( ) ersetzen."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. Doppelklicken Sie auf die Python-Datei, um sie auszuführen und die Konvertierung durchzuführen.

Antwort4

Hier ist ein weiteres VBA-Makro, das relativ schnell ausgeführt werden sollte, da es die Arbeit in VBA-Arrays und nicht im Arbeitsblatt ausführt.

Dabei wird angenommen, dass die Quelldaten in A1 oder A2 beginnen, dass der Datenbereich zusammenhängend ist und dass die E-Mails für jedes Unternehmen zusammenhängend sind (sodass die erste leere Zelle in einer Zeile nach der letzten E-Mail-Adresse steht). Der Code müsste geringfügig geändert werden, wenn eine dieser Annahmen nicht zutrifft.

Außerdem wird davon ausgegangen, dass keine Spaltenbeschriftungen vorhanden sind. In den Codekommentaren finden Sie Anweisungen, wie dies ausgeglichen werden kann.

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

verwandte Informationen