Live-Forum - Die aktuellen Beiträge
Anzeige
Archiv - Navigation
764to768
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
764to768
764to768
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Inhaltsverzeichnis

Strings aufteilen hakt

Strings aufteilen hakt
19.05.2006 14:36:19
Reinhard
Hallo Wissende,
https://www.herber.de/bbs/user/33788.txt
Zum Testen bitte unbedingt in .rtf umbenennen, ist nur wegen dm Hochladen .txt.
Um diese rtf-Datei (aus Word) in Excel gelistet aufzulisten erstellte ich mir mit Hilfe von hier die nachfolgenden Codes. An sich funktionieren sie, aber bei einigen wenigen Zeilen in der rtf-Datei versagen sie und trennen die Zeile falsch auf. Ich dachte erst es läge am Split, deshalb die Variante mit der eigenen Splitfunktion, aber Ergebnis bleibt leider identisch.
aus:
Gerlach, Marcus, Berlin, *03.03.1975, Einlage: 51.129,19 EUR
Gerst, Joachim Peter, München, Einlage: 20.000,00 DEM
Gerstner, Gerald, Harthausen, "02.08.1953, Einlage: ! 25.564,59 EUR
Gesellschaft bürgerlichen Rechts Jens und Jörg Pallentin, bestehend aus a) Jens Pallentin,*10.04.1962, Buxtehude und
b) Jörg Pallentin,*11.09.1964, Buxtehude, Einlage: 51.129,19 EUR
Gießler, Beate Anna, Lingen, Einlage: 30.000,00 DEM
Gillmeier, Maria, ! Pilsting, Einlage: 100.000,00 DEM
wird in Excel:
     A           B                 C               D            E           F        G
40                Gerlach           Marcus        Berlin   03.03.1975   51129,19   EUR
41                  Gerst    Joachim Peter       München                   20000    DM
42               Gerstner                                               25564,59   EUR
43      b) Jörg Pallentin                                  11.09.1964   51129,19   EUR
44                Gießler       Beate Anna        Lingen                   30000    DM
45              Gillmeier            Maria    ! Pilsting                  100000    DM

Hier ist die datei: https://www.herber.de/bbs/user/33789.xls
Danke ^ Gruß
Reinhard
Option Explicit
Dim Satz3()
' Die Bibliothek "Microsoft Word x.x Object Library"
' muss aktiviert sein (EARLY BINDING)
Sub ImportFromWord1()
Dim WordApp As New Word.Application, strPath As String, wks1 As Worksheet
Dim strFile As String, zei, s, s2, s3, n, kurz
strFile = Worksheets("Tabelle2").Range("B1") 'cape race.rtf
Set wks1 = ThisWorkbook.Worksheets("Tabelle1")
wks1.UsedRange.Clear
strPath = Worksheets("Tabelle2").Range("A1") 'c:\Andre
With WordApp
.ChangeFileOpenDirectory strPath
.Documents.Open strFile
With .Selection
.WholeStory
.Copy
End With
wks1.Range("A1").Select
wks1.Paste
wks1.Range("A1").Select
.ActiveDocument.Close SaveChanges:=False
.Quit
End With
For zei = ActiveSheet.Range("A65536").End(xlUp).Row To 1 Step -1
Cells(zei, 1).HorizontalAlignment = xlCenter
Cells(zei, 1).HorizontalAlignment = xlLeft
If InStr(Cells(zei, 1), "Einlage") <= 0 Then
Cells(zei, 1).EntireRow.Delete
Else
s = Split(Cells(zei, 1), "Einlage:")
s2 = Split(s(0), "*")
If UBound(s2) > 0 Then Cells(zei, 5) = Left(s2(1), 10)
If InStrRev(s2(0), ",") >= Len(s2(0)) - 2 Then s2(0) = Left(s2(0), InStrRev(s2(0), ",") - 1)
s3 = Split(s2(0), ",")
Cells(zei, 1) = ""
For n = 1 To 2
If InStr(s3(0), "Dr.") > 0 And InStr(s3(0), "Dr.") < 6 Then
If Cells(zei, 1) <> "" Then Cells(zei, 1) = Cells(zei, 1) & " "
Cells(zei, 1) = Cells(zei, 1) & "Dr."
s3(0) = Mid(s3(0), InStr(s3(0), "Dr.") + 4)
End If
Next n
Cells(zei, 2) = s3(0)
If UBound(s3) = 2 Then
Cells(zei, 3) = s3(1)
Cells(zei, 4) = s3(2)
End If
If UBound(s3) = 1 Then Cells(zei, 4) = s3(1)
'Cells(zei, 3) = s3(UBound(s3))
If UBound(s) = 1 And InStr(s(1), ",") > 0 Then
s2 = Split(s(1), ",")
kurz = ""
For n = 1 To Len(s2(0))
If Mid(s2(0), n, 1) >= "0" And Mid(s2(0), n, 1) <= "9" Then kurz = kurz & Mid(s2(0), n, 1)
Next n
Cells(zei, 6) = CLng(kurz) + Left(s2(1), 2) / 100
Cells(zei, 7) = Right(s2(1), 3)
If InStr(Cells(zei, 7), "DEM") > 0 Then Cells(zei, 7) = "DM"
End If
End If
Next zei
zei = ActiveSheet.Range("A65536").End(xlUp).Row
Range("f1:f" & zei).NumberFormat = "#,##0.00"
Columns("A:G").AutoFit
Fehler:
Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Sub
Sub ImportFromWord2()
Dim WordApp As New Word.Application, strPath As String, wks1 As Worksheet, Satz4
Dim strFile As String, zei, s, n, kurz
strFile = Worksheets("Tabelle2").Range("B1") 'cape race.rtf
Set wks1 = ThisWorkbook.Worksheets("Tabelle1")
wks1.UsedRange.Clear
strPath = Worksheets("Tabelle2").Range("A1") 'c:\Andre
With WordApp
.ChangeFileOpenDirectory strPath
.Documents.Open strFile
With .Selection
.WholeStory
.Copy
End With
wks1.Range("A1").Select
wks1.Paste
wks1.Range("A1").Select
.ActiveDocument.Close SaveChanges:=False
.Quit
End With
For zei = ActiveSheet.Range("A65536").End(xlUp).Row To 1 Step -1
Cells(zei, 1).HorizontalAlignment = xlCenter 'ohne diese beiden befehel steht der Text nach rechts verschoben in der Zelle!?
Cells(zei, 1).HorizontalAlignment = xlLeft
If InStr(Cells(zei, 1), "Einlage") <= 0 Then
Cells(zei, 1).EntireRow.Delete 'keine Einlage wird gelöscht
Else
Call Split2(Cells(zei, 1), "Einlage:")
s = Satz3 'Speichern für später
Call Split2(Satz3(0), "*") '* bedeutet es gibt ein Geburtsdatum
If UBound(Satz3) > 0 Then Cells(zei, 5) = Left(Satz3(1), 10) 'Geburtsdatum in E
'Entfernen von Kommas am Ende
If InStrRev(Satz3(0), ",") >= Len(Satz3(0)) - 2 Then Satz3(0) = Left(Satz3(0), InStrRev(Satz3(0), ",") - 1)
Satz4 = Satz3
Call Split2(Satz4(0), ",") 'Auftrennen nach Kommas
Cells(zei, 1) = ""
For n = 1 To 2 'Dr. bzw Dr.Dr. in A und Dr. aus Satz3(x) entfernen
If InStr(Satz3(0), "Dr.") > 0 And InStr(Satz3(0), "Dr.") < 6 Then
If Cells(zei, 1) <> "" Then Cells(zei, 1) = Cells(zei, 1) & " "
Cells(zei, 1) = Cells(zei, 1) & "Dr."
Satz3(0) = Mid(Satz3(0), InStr(Satz3(0), "Dr.") + 4)
End If
Next n
Cells(zei, 2) = Satz3(0)
If UBound(Satz3) = 2 Then 'Es gibt Name,Vorname,Stadt
Cells(zei, 3) = Satz3(1)
Cells(zei, 4) = Satz3(2)
End If
If UBound(Satz3) = 1 Then Cells(zei, 4) = Satz3(1) 'es gibt Firma,Stadt
If UBound(s) = 1 And InStr(s(1), ",") > 0 Then
'in s wurde anfangs alles gespeichert was nach "Einlage" steht, alos Euro,Cent,EUR bzw DM,Pfg,DEM
Call Split2(s(1), ",")
kurz = ""
For n = 1 To Len(Satz3(0)) 'Entfernen von Sonderzeichen aus dem Betrag
If Mid(Satz3(0), n, 1) >= "0" And Mid(Satz3(0), n, 1) <= "9" Then kurz = kurz & Mid(Satz3(0), n, 1)
Next n
Cells(zei, 6) = CLng(kurz) + Left(Satz3(1), 2) / 100 'Betrag in F
Cells(zei, 7) = Right(Satz3(1), 3) 'Währung in G
If InStr(Cells(zei, 7), "DEM") > 0 Then Cells(zei, 7) = "DM"
End If
End If
Next zei
zei = ActiveSheet.Range("A65536").End(xlUp).Row
Range("f1:f" & zei).NumberFormat = "#,##0.00"
Columns("A:G").AutoFit
Fehler:
Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Sub
Sub Split2(ByVal Satz As String, ByVal Trenner As String)
Dim anz
'anz = 0
While InStr(Satz, Trenner) > 0
ReDim Preserve Satz3(anz)
Satz3(anz) = Left(Satz, InStr(Satz, Trenner) - 1)
Satz = Mid(Satz, InStr(Satz, Trenner) + Len(Trenner))
anz = anz + 1
Wend
ReDim Preserve Satz3(anz)
Satz3(anz) = Satz
End Sub

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

Betreff
Datum
Anwender
Anzeige
AW: Strings aufteilen hakt
19.05.2006 16:09:44
Martina
hi,
erstmal Infos zum rtf-Format:
http://www11.informatik.tu-muenchen.de/publications/da/fuhrmann96/beschreib.html#RTF
vielleicht kann man ja mit dieser Information ein script basteln und das Ding als Text einlesen, was ich allerdings bezweifle da sie nach meiner (nicht unbedingt massgeblichen) Meinung nicht unbedingt fehlerfrei ist. Sie wird weder in Word noch in einem anderem Tool:
http://www.pcfreunde.de/download/detail-10973/rtf-convertor.html
richtig (was natürlich auch wieder Auslegungssache ist) dargestellt
MfG Martina
p.s. ich lass mal offen
Anzeige
AW: Strings aufteilen hakt
19.05.2006 16:15:52
Reinhard
hallo Martina,
Danke erstmal, bin auf'm Sprung und schaue mir das heute Abend an.
Lieben Gruß
Reinhard
AW: Strings aufteilen hakt
19.05.2006 22:04:30
Reinhard
Hallo Martina,
bisher dachte ich immer das reiche TextFormat kennt nur Text, und dachte dass .txt =AsCII ist und rtf=ANSI ist, oder umgedreht. Dass rtf Grafiken "kann" wußte ich nicht.
Bei den PcFreunden bin ich nicht eingetreten, denn ich will wissen warum mein Code "hakt"
Lieben Gruß
Reinhard
AW: Strings aufteilen hakt
19.05.2006 22:14:14
Martina
hi,
du sollst ja auch nicht eintreten, nur ein wenig runterscrollen und dann die Freeware downloaden und ausprobieren
MfG
AW: Strings aufteilen hakt
19.05.2006 23:57:27
Reinhard
Hallo Martina,
die Datei habe ich von nem Typen der 70-130 Eus dafür bot dies Problemm zu lösen.
Er arbeitet bei Microsoft.com *kicher*
Und es wäre das erstemal dass ich damit Geld verdienen würde *Auftragsprogrammierer werde*
Die rtf ist eingescannt worden, deshalb diese Sonderzeichen weil MS auch an OCR spart *annehm*
Aber das sind Peanuts, ich will wissen warum nach Gerstner 2 Zeilen lang was Falsches gelistet wird.
Und , mein "Kunde" (DAU?) ist auch nicht sehr hilfreich :-( Abgesehen von den falschen Aufteilungen läuft mein Code durch. Ich schickte ihm die Datei. Er sagte, da käm ein Fehler. Ich sagte ihm er solle mir sagen was denn in dem Fehlerfensterchen steht, dann auf "Debuggen" klicken und mir sagen welche zeile da markiert wird.
Naja , Antwort war, er hätte keine Ahnung von Vba
Ich sagte ich habe XL2000 auf Win XP als EinzelPC, ging er gar nicht drauf ein, habe ich ne Glaskugel um herasuzufinden was der da falsch macht?
Ich muss ja ncht alles verstehen in dieser Welt :-)
Kennst du Wattlschawik o.ä, die Geschichte mit dem Hammer? Bin nah dran:-)
Gruß
Reinhard
ps: Ich freue mich über eine Rückmeldung ob diese Antwort hilfreich war oder nicht..
Anzeige
AW: Strings aufteilen hakt
19.05.2006 23:21:19
Reinhard
Liebste Martina die ich kenne,
naja, bist die Einzigste :-)
das will ich ja grad nicht, ich will das selbst per Vba lösen, ich will wissen warum mein Makro bei Gerstner, ... versagt
Wieso bei dem? Bei Müller,Schulze,Schmidt klappt es, warum da, an dieser Stelle, kapier das nicht.
Ich werde mir morgen das das Umwandlungsteil runterladen um zu prüfen ob die Software das sauber eingelesen bekommt.
Es würde mich sehr freuen wenn die das auch nicht gebacken bekommen.
Andreseits, wenn die Software das schaffen sollte ist das nett, nützt mir aber nix:-(
Guts Nächtle
Reinhard
ps: Ich freue mich über eine Rückmeldung ob diese Antwort hilfreich war oder nicht..
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige