Text per Makro in Zeile schreiben

[Hawkeye]

Hallo zusammen

Im Anhang findet ihr eine Kundendatenbank. Diese verwende ich, um Adresse, Telefonnummer etc. einzutragen.
Nun bekomme ich von einem unserer Partner die Kundendaten in folgender (Text)Form:

[Herr/Frau]
[Vorname] [Nachname]
[Strasse inkl. Nummer]
[PLZ] [Ort]
Tel. [Tel. Nr.]
E-Mail: [E-Mail]

Ist es möglich, ein Makro oder so (am besten oben angeordnet wie die 2 bestehenden) zu erstellen, das eine Eingabemaske öffnet in der ich die Daten als gesamtes einfügen kann und sie nachher als gesamtes auf die nächste freie Linie geschrieben werden (in die richtigen Felder)?
Bei der Telefonnummer müsste das Makro noch folgende Anpassung machen: Von +41797778899 auf +41 79 777 88 99 (also Abstände einfügen)

Es wäre seeehr toll wenn das jemand hinkriegen könnte, da es mir täglich sicher 30 Minuten Arbeit sparen würde...

Liebe Grüsse

Hawkeye

[Fennek]

Hallo,

wie werden die Adressen denn geliefert? Einzeln oder als txt-Datei mit vielen Adresse?

mfg

PS: technisch gesehen dürfte die Anfrage relativ einfach zu beantworten sein, bzw viele ähnliche Fragen wurden hier bearbeitet.

[Hawkeye]

Hallo

Die Daten werden einzeln geliefert. Also pro Tag ca. 3-4 E-Mails mit pro E-Mail Infos zu einem Kunden.

Vielen Dank für die Hilfe

[Fennek]

Hi,

nachdem ich viel zu lange getestet habe, per copy/paste eine userForm zu füllen....


##########  Beitrag offen #############

mfg

[RPP63]

Moin!
Du solltest den Kunden bitten, Adressdaten per .csv zu schicken.
Dann ist der Import überhaupt kein Problem!
Außerdem dürfte dies gängige Praxis sein.

Gruß Ralf

[Hawkeye]

Hallo Ralf

Das ist leider nicht möglich, wir erhalten die Daten über eine grosse Vermittlungsplattform welche uns die Informationen standardisiert per E-Mail in der oben beschriebenen Form zukommen lässt.

Es wäre wirklich genial wenn das irgendwie klappen würde. Danke auch Dir Fennek fürs rumtüfteln

[Gast 123]

Hallo

wenn daran nichts geaendert werden kann git der alte Praktiker Spruch:  "was nicht passt - wird passend gemacht!"

Anbei deine Beisoieldatei mit einer Makro Lösung zurück. Die Daten einfach ins Eingabeblatt kopieren, aufbereiten, und in die Kundendatenbank kopieren. Beim Aufbereiten bitte prüfen ob der Name richtig zerlegt wurde, denn mein Makro kann bei mehreren Vornamen oder Doppel Namen mit "-" nicht erlkennen wie er richtig lauten soll. Zuviel Arbeit!

Ich hoffe das die angebotene Lösung in der Praxis weiter hilft. Bitte zuerst in der Beispieldatei testen ob es klappt.

mfg  Gast 123

[Kuwer]

Hallo Hawkeye,

hier eine Variante mit  UserForm. In das TextFeld1 (mit Multiline = True) wird einfach das Kopierte per strg+v eingefügt.

Private Sub TextBox1_Change()
 Dim varText As Variant
 If Len(TextBox1) Then
   varText = Split(TextBox1, vbNewLine)
   With Cells(2002, 5).End(xlUp)
     .Offset(1, -2).Activate
     .Offset(1, -2).Value = varText(0)
     .Offset(1, -1).Value = Left(varText(1), InStrRev(varText(1), " ") - 1)
     .Offset(1, 0).Value = Mid(varText(1), InStrRev(varText(1), " ") + 1)
     .Offset(1, 2).Value = varText(2)
     .Offset(1, 3).Value = "'" & Left(varText(3), InStr(1, varText(3), " ") - 1)
     .Offset(1, 4).Value = Mid(varText(3), InStr(1, varText(3), " ") + 1)
     .Offset(1, 5).Value = Mid(varText(5), 9)
     .Offset(1, 7).Value = "'" & Format(Mid(varText(4), 6), "+00 00 000 00 00")
   End With
   TextBox1 = ""
 End If
End Sub

Gruß Uwe

[Fennek]

Hallo,

@Kuwer: das mit Multiline hatte ich wohl übersehen, danke

mit der Suchmaschine habe ich diesen Ansatz gefunden. Es geht auch ohne (sichtbare) Form direkt in eine Variable:

Code:

Dim objData As New MSForms.DataObject

Sub Fen()
objData.GetFromClipboard
F0 = objData.GetText()
Debug.Print F0
End Sub

mfg

[Gast 123]

Hallo,

mir ist nachher eingefallen das im Code -Daten aufbereiten- die Anweisung "alte Daten löschen" fehlt. Ebenso habe ich den Befehl InStr() durch InStrRev() ersetzt. Damit erfasst der neue :Code auch 2-3 Vornamen. Nur wenn weitere Angaben wie "Dr." oder Adelstitel wie "von" davor stehen kann das Makro den String nicht korrekt zerlegen. Würde mich freuen wenn ich weiterhelfen konnte.

Es gibt auch noch andere Lösungen, die habe ich aber nicht getestet.

mfg  Gast 123   

Code:

Sub Daten_aufbereiten()
Dim Ort, PLZ, Tel
Dim FName, VName, Txt
Dim Tx1, Tx2, Tx3, Tx4, Tx5
With Worksheets("Eingabe")
  'alte Daten löschen
  .Range("C1:D7").ClearContents

  'PLZ % Ort in String zerlegen
  Ort = .Cells(5, 2).Value   'PLZ + Ort
  Tel = .Cells(6, 2).Value   'Telefon
  PLZ = Left(Ort, 5): VName = ""
  Ort = Right(Ort, Len(Ort) - 5)
 
  'Name in String zerlegen
  Txt = .Cells(3, 2).Value   'Vorname, Nachname
  If InStrRev(Txt, " ") Then VName = Left(Txt, InStrRev(Txt, " "))
  FName = Right(Txt, Len(Txt) - Len(VName))