Microsoft Excel

Herbers Excel/VBA-Archiv

CSV: Text in Spalten / Tabelle


Betrifft: CSV: Text in Spalten / Tabelle von: Janosch J.
Geschrieben am: 12.01.2018 11:16:03

Hallo miteinander,

ich stehe vor folgendem Problem:
Ich exportiere mit Hilfe des ImportExportTolls aus Thunderbird alle Mails aus einem bestimmten Ordner. Diese Mails haben alle den gleichen Aufbau (wobei statt der Informationen in Anfühgunszeichen variable Daten vorhanden sind):

Anfrage-Formular

Anrede: "Anrede"
Vorname: "Vorname"
Nachname: "Nachname"
Telefon: "Telefonnummer"
eMail: "Mailadresse"
Frage:
Frage (und Zeilenumbruch)
"Frage"

Die exportierten Daten zusammen mit dem Inhalt einer solchen Mail sehen als CSV dann so aus:

Anfrage-Formular
Von:
"Absender"
Datum:
"dd.mm.yyyy hh:mm"
An:
"Empfänger"

Anfrage-Formular

Anrede: "Anrede"
Vorname: "Vorname"
Nachname: "Nachname"
Telefon: "Telefonnummer"
eMail: "Mailadresse"
Frage:
Frage (und Zeilenumbruch)
"Frage"

Zwischen 2 Datensätzen entstehen 4 leere Zeilen.

Nun möchte ich gern diese (bzw. eine Auswahl dieser) Daten automatisch in eine Tabelle einfügen. Entscheidend sind dabei für mich die fett markierten Daten. Meine Überlegung ist es. die entsprechenden Datensätze zu kopieren und transponiert an anderer Stelle wieder einzusetzen (und die nicht benötigten Spalten auszublenden). Aber wie bekomme ich es hin, dass ein Datensatz erkannt und entsprechend transponiert wird? Also wenn ich quasi hunderte dieser Datensätze untereinander in einer Datei habe? Stehe ich einfach nur auf dem Schlauch?

Ich bin für jede Anregung dankbar!!
Schöne Grüße
Jolonosch

  

Betrifft: AW: Specialcells(2) von: Fennek
Geschrieben am: 12.01.2018 11:21:24

Hallo,

da di Blöcke mit einer (mehreren) Leerzeilen getrennt sind, kann man mit columns(1).specialcells(2) darauf zugreifen und transponieren.

mfg


  

Betrifft: AW: Specialcells(2) von: Janosch J.
Geschrieben am: 12.01.2018 12:55:40

Muss ich in dem Fall die einzelnen leeren Zeilen vorab entfernen? Sonst greift das doch bereits innerhalb der einzelnen Datensätze, oder?


  

Betrifft: AW: Ein Versuch von: Fennek
Geschrieben am: 12.01.2018 13:53:57

Hallo,

unt
getestet: der Code liest eine CSV ein und transponiert die Inhalte (ohne selbst zu testen ist das ziemlicher Wahnsinn, debuggen ist notwendig)

sub test()
sheets.add(,,,"C:\temp\MeineCSV.csv"))
with activesheet.columns(1)
    for each ar in .specialcells(2).areas
        r=r+1
        cells(r,6) = application.transpose(ar)
        'hier die Codes mit split(rng.cells(i), ":")(1)
    next ar

end with
end sub
Schauen wir mal ...

mfg


  

Betrifft: AW: Ein Versuch von: Janosch J.
Geschrieben am: 12.01.2018 15:11:52

Der Einfachheit halber habe ich mal eine exemplarische Datei hochgeladen:

https://www.herber.de/bbs/user/118901.xlsx


  

Betrifft: AW: getestet von: Fennek
Geschrieben am: 12.01.2018 16:07:43

Hallo,

unter der Annahmen, dass ein Block immer mit "Anfr ... Betreff" beginnt:

Sub Vorbereitung()
Dim rng As Range
Head = Array("Datum", "Anrede", "Vorname", "Name", "Telefon", "E-Mail", "Text1", "Text2", " _
Text3")
Sheets(2).Range("A1").Resize(, UBound(Head) + 1) = Head
With ActiveSheet.UsedRange.Columns(1)
    .Replace "Anfrage-Formular ", "Anfrage-Formular"
    Set rng = .Find("Anfrage-Formular", , xlValues, xlWhole, 1)
    If Not rng Is Nothing Then
        Anf = rng.Address
        Do
        If IsEmpty(rng.Offset(-1)) Then rng.Offset(-1) = "n"
        If IsEmpty(rng.Offset(1)) Then rng.Offset(1) = "n"
        Set rng = .FindNext(rng)
        Loop Until rng.Address = Anf
    End If
End With
End Sub

Sub Tranponieren()
'Sheets(2) muss angelegt sein
With Sheets(2)
ls = .Cells(Rows.Count, 1).End(xlUp).Row + 1
For Each ar In Columns(1).SpecialCells(2).Areas
    .Cells(ls, 1) = ar.Cells(6) 'Datum
    .Cells(ls, 2) = Split(ar.Cells(12), ":")(1) 'Anrede
    .Cells(ls, 3) = Split(ar.Cells(13), ":")(1) 'Vorname
    .Cells(ls, 4) = Split(ar.Cells(12), ":")(1) 'Name
    .Cells(ls, 5) = Split(ar.Cells(15), ":")(1) 'Tel
    .Cells(ls, 6) = Split(ar.Cells(16), ":")(1) 'e-mail
    If ar.Count >= 18 Then .Cells(ls, 7) = ar.Cells(18)
    If ar.Count >= 19 Then .Cells(ls, 8) = ar.Cells(19)
    If ar.Count >= 20 Then .Cells(ls, 9) = ar.Cells(20)
    ls = ls + 1
Next ar
End With
End Sub
Zuerst muss ein zweites Sheet angelegt werden.

mfg


  

Betrifft: AW: Ein Versuch von: Janosch J.
Geschrieben am: 12.01.2018 15:40:25

Der Einfachheit halber habe ich mal eine exemplarische Datei hochgeladen:

https://www.herber.de/bbs/user/118901.xlsx


  

Betrifft: AW: Vorschlag mit Datei von: Fennek
Geschrieben am: 12.01.2018 17:29:50

die erste Zelle wurde ergänzt:

https://www.herber.de/bbs/user/118909.xlsm


Beiträge aus dem Excel-Forum zum Thema "CSV: Text in Spalten / Tabelle"