Registriert seit: 1. Dez 2004
Ort: Köln
1.295 Beiträge
Delphi 12 Athens
|
AW: CSV anpassen
17. Jan 2021, 13:23
Probier es mal damit. BtnStartClick muss du dir entsprechend anpassen:
Delphi-Quellcode:
Procedure SplitAtPosAndTrim(const aSource: String; const aPosOfRightPart: Integer; var aLeftPart: string; var aRightPart: String);
begin
aRightPart := Trim(copy(aSource, aPosOfRightPart, length(aSource) - aPosOfRightPart+1));
aLeftPart := Trim(copy(aSource, 1, aPosOfRightPart-1));
end;
Function KonvertToCsvString(aSourceString: String): String;
const
lTitelVorgaben: array [0 .. 2] of string = ('Dr.', 'Prof.', 'Dipl.-Ing.');
var
lAnrede: String;
lTitel1: String;
lTitel2: String;
lNachname: String;
lVorname: String;
lMit: string;
var
lpos: Integer;
a: Integer;
begin
//*************************************************************
// Vorsorglich Sonderzeichnen und Leerzeichen am Anfang und Ende ntfernen
aSourceString := Trim(aSourceString);
//*************************************************************
// "mit" ist immer vorhanden und muss extrahiert werden
SplitAtPosAndTrim(aSourceString, length(aSourceString) - 3, aSourceString, lMit);
// Hier ggf kontrollieren, ob Source tatsächlich mit dem Wort "Mit" endete. > "if not SameText(lmit,'mit') then"
//*************************************************************
// Anrede ist immer als erstes vorhanden. Bis zum ersten Leerzeichen.
lpos := PosEx(' ', aSourceString);
SplitAtPosAndTrim(aSourceString, lpos, lAnrede, aSourceString);
//*************************************************************
// Anrede 1 filtern
for a := low(lTitelVorgaben) to high(lTitelVorgaben) do
if StartsText(lTitelVorgaben[a], aSourceString) then
begin
SplitAtPosAndTrim(aSourceString, length(lTitelVorgaben[a]) + 1, lTitel1, aSourceString);
Break;
end;
//*************************************************************
// Anrede 2 filtern
for a := low(lTitelVorgaben) to high(lTitelVorgaben) do
if StartsText(lTitelVorgaben[a], aSourceString) then
begin
SplitAtPosAndTrim(aSourceString, length(lTitelVorgaben[a]) + 1, lTitel2, aSourceString);
Break;
end;
//***************************************************************************************
// Nachname und Vorname ermitteln
lpos := pos(',', aSourceString);
if lpos = 0 then
lNachname := aSourceString
else
begin
SplitAtPosAndTrim(aSourceString, lpos + 1, lNachname, lVorname);
// abschliessendes Komma entfernen
lNachname := copy(lNachname, 1, length(lNachname) - 1);
end;
Result := lAnrede + ';' + lTitel1 + ';' + lTitel2 + ';' + lNachname + ';' + lVorname + ';' + lMit;
end;
procedure TForm1.BtnStartClick(Sender: TObject);
var
a:Integer;
begin
for a:=0 to MemoSource.lines.count-1 do
MemoDest.lines.add(KonvertToCsvString(MemoSource.Lines[a]));
end;
|
|
Zitat
|