CSV: Text in Spalten / Tabelle

Forumthread: CSV: Text in Spalten / Tabelle

12.01.2018 11:16:03

Janosch

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

7
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

AW: Specialcells(2)

12.01.2018 11:21:24

Fennek

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

AW: Specialcells(2)

12.01.2018 12:55:40

Janosch

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

AW: Ein Versuch

12.01.2018 13:53:57

Fennek

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

AW: Ein Versuch

12.01.2018 15:11:52

Janosch

Der Einfachheit halber habe ich mal eine exemplarische Datei hochgeladen:
https://www.herber.de/bbs/user/118901.xlsx

AW: getestet

12.01.2018 16:07:43

Fennek

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

AW: Ein Versuch

12.01.2018 15:40:25

Janosch

Der Einfachheit halber habe ich mal eine exemplarische Datei hochgeladen:
https://www.herber.de/bbs/user/118901.xlsx

AW: Vorschlag mit Datei

12.01.2018 17:29:50

Fennek

die erste Zelle wurde ergänzt:
https://www.herber.de/bbs/user/118909.xlsm

Beliebteste Forumthreads (12 Monate)

Forumthread: CSV: Text in Spalten / Tabelle

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

Forumthreads zu verwandten Themen

VBA Beispiele zu diesem und ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

7
Beiträge zum Forumthread

Beiträge zu diesem Forumthread