CSV: Text in Spalten / Tabelle

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

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

AW: Specialcells(2)

12.01.2018 11:21:24

Fennek

AW: Specialcells(2)

12.01.2018 12:55:40

Janosch

AW: Ein Versuch

12.01.2018 13:53:57

Fennek

AW: Ein Versuch

12.01.2018 15:11:52

Janosch

AW: getestet

12.01.2018 16:07:43

Fennek

AW: Ein Versuch

12.01.2018 15:40:25

Janosch

AW: Vorschlag mit Datei

12.01.2018 17:29:50

Fennek

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

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

Beliebteste Forumthreads (12 Monate)

7
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

339 Forumthreads zu ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

CSV: Text in Spalten / Tabelle

7 Beiträge zum Forumthread Beiträge zu diesem Forumthread

339 Forumthreads zu ähnlichen Themen

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

7
Beiträge zum Forumthread

Beiträge zu diesem Forumthread