Geloest :Bestimmte Werte auslesen aus Zelle

[keksi1970]

Hi, und wieder ich

folgende Aufgabenstellung hab ich :

ich möchte auf einfachstem Wege Zahlen aus einem Text auslesen, und zwar die Uhrzeit des Fixtermins

Folgendes Problem stellt sich dabei im Inhalt der Zellen :

Fixtermin 6:30
Fix 8°°
Fix 7,30
Fixtermin 8,45
Fix 7 Uhr
Fix 8.00 Uhr

zusätzlich können auch Telefonnummern, Abholnummern und Postleitzahlen in diesem Text vorkommen.

Mein Lösungsansatz wäre :

Die ersten 4 Zeichen, die mit einer Zahl beginnen UND nach dem Wort(oder Wortteil) Fix +"<leerzeichen>" UND nicht durch ein <leerzeichen> unterbrochen sind auslesen und in einer Variablen speichern. anschliessen diese Variable auslesen bis zum 1. Text-Zeichen oder Sonderzeichen und in das Format "##," bringen. Danach alle weiteren Textzeichen ignorieren und bis zum 1. Leerzeichen alle Zahlen nach dem komma einfügen. anschliessend das ganze in das FOrmat ##,## formatieren.

Nur : wie mache ich das ??

Gruß Andreas

btw : die komischen Zeitformatierungen stammen alle von verschiedenen Kollegen, je nachdem, welche Vorlieben er besitzt

[turtle47]

Hallo Andreas,

eine direkte Lösung kann ich Dir leider nicht bieten aber vielleicht einen Ansatz.
Schau Dir mal folgenden Code den ich mal geschrieben habe um die Syntax einer
Mailadresse auf Richtigkeit überprüft:

Code: Alles auswählen

Sub Check_Mail_Syntax
	Mailadresse = "info@mail.de" 'gültig
	'Mailadresse = "info.mail@mail.de" 'gültig
	'Mailadresse = "info@mail.com" 'gültig
	'Mailadresse = "info@mail.info" 'gültig
	'Mailadresse = "info@mail.d" 'ungültig Endung zu kurz
	'Mailadresse = "info@mail.infos" 'ungültig Endung zu lang
	'Mailadresse = "info@mailbiz" 'unültig weil Punkt fehlt
	'Mailadresse = "infomail.net" 'unültig weil @ fehlt
	'Mailadresse = "info@@mail.de" 'unültig weil @ doppelt
	Laenge= LEN(Mailadresse)
	a = 1
	for i = 1 to Laenge
	Zeichen1 = Mid(Mailadresse,a,1)
	if Zeichen1 = "@" Then
	goto FindPoint
	else
	if a = Laenge then
	goto  Mail_Not_ok
	exit Sub
	end if
	end if
	a = a+1
	next i
	FindPoint: 
 	y = 1
	for i = 0 to 2  
	FindPoint1 = right(Mailadresse,5)
	FindPoint1 = mid(FindPoint1,y,1)
	if FindPoint1 = "." Then
	else
	if y > 2 Then
	goto Mail_Not_ok
	exit Sub
	end if
	end if
	y = y + 1
	next i
	Check_aet_Count = 1
	Check_aet_Count1 = 0 
	for k = 1 to Laenge
	Check_aet = Mid(Mailadresse,Check_aet_Count,1)
	if  Check_aet = "@" Then
	Check_aet_Count1 = Check_aet_Count1 + 1
	end if
	Check_aet_Count = Check_aet_Count + 1
	if Check_aet_Count1 > 1 Then
	goto Mail_Not_ok
	end if
	next k
	Check_Space_1 = 1
	for k = 1 to Laenge
	Check_Space = Mid(Mailadresse,Check_Space_1,1)
	if  Check_Space = chr(32)  Then
	goto Mail_Not_ok
	end if
	Check_Space_1 = Check_Space_1 +1
	next k	
	Mail_ok: msgbox "Die Mailadresse ist gültig"
	exit sub
	Mail_Not_ok: msgbox "Die Mailadresse ist nicht gültig!"
End Sub

Schöne Grüße.

Jürgen

[turtle47]

Hi Andreas,

Nur : wie mache ich das ??

Na, einfach so:

Code: Alles auswählen

Dim s(i) as String
Dim myString as String
Dim SecondPartResult as integer
Dim FirstPartResult as integer

Sub Start
	String_auslesen
	ZweiterTeil 'vordere Zahlenfolge auslesen
	DritterTeil 'hintere Zahlenfolge auslesen
	EndResult
end Sub

Sub String_auslesen
	Dim Ist_Numeric as integer
	Dim Zelltext as String
	Dim Laenge1 as integer
	Zelltext = ("Fix 8:34 Uhr Tel. 02225-12345 43 ")
	'Zelltext = ("Fixtermin 6:30 Tour 22")
	'Zelltext = ("Fix 8°°")
	'Zelltext = ("Fix 7,30 Plz: 53359")
	'Zelltext = ("Fixtermin 8,45")
	'Zelltext = ("Fix 7 Uhr")
	'Zelltext = ("Fix 8.10 Uhr")
	Laenge= LEN(Zelltext)
	Check_Space_1 = 0
	for k = 1 to Laenge
	Check_Space = Mid(Zelltext,k,1)
	if  Check_Space = " "  Then
	Check_Space_1 = Check_Space_1 + 1
	end if
	next k	
	t = Check_Space_1 '-1
	for i = 0 to t
	Dim s(1) as String
	s() = Split(Zelltext)
	Aktuell_Wert = s(i)
	Aktuell_Wert1 = left(Aktuell_Wert,1)
	if  isnumeric(Aktuell_Wert1) Then 
	Laenge1 = LEN (s(i))
	myString = s(i)
	exit Sub
	end if
	next i
End Sub

Sub ZweiterTeil
	Dim LaengeMyString as integer
	LaengeMyString = LEN(myString)
	Ist_Numeric1 = 1
	for z = 1 to LaengeMyString
	FirstPart1 = mid(myString,Ist_Numeric1,1)
	if   isnumeric(FirstPart1) Then	
	Ist_Numeric1 = Ist_Numeric1 + 1
	FirstPartResult = Left(myString,Ist_Numeric1-1)
	end if
next z	
End Sub

Sub DritterTeil
	Dim LaengeMyString as integer
	LaengeMyString = LEN(myString)
	Ist_Numeric2 = LaengeMyString
	x = 1
	for z = 1 to LaengeMyString
	SecondPart1 = mid(myString,Ist_Numeric2,1)
	if   isnumeric(SecondPart1) Then	
	Ist_Numeric2 = Ist_Numeric2 - 1
	SecondPartResult = right(myString,Ist_Numeric2)
	end if
	next z
End Sub

Sub EndResult
	myEndResult= FirstPartResult & "," & SecondPartResult
	MyFormat = Format(myEndResult, "00.00"
	msgbox MyFormat
End Sub

Jürgen

[keksi1970]

danke Jürgen,

aber ich glaube ich muss das Problem etwas anders angehen

Später mehr dazu

Gruß Andreas

[keksi1970]

so, also hier meine Lösung, vielleicht nicht perfekt, aber funktioniert

Code: Alles auswählen

Sub Fixtermine_Auslesen

Dim FixDoc as object
Dim Fixsheet as object

Fixdoc = ThisComponent
Fixsheet = Fixdoc.sheets(0)
FIxRange = Fixsheet.getcellRangeByName("$W1:$W350")
FixSuchen = FixRange.createReplaceDescriptor
FixSuchen.setSearchString("Fixtermin")
FixSuchen.setReplaceString("Fix ")
Fixrange.replaceAll(FixSuchen)

FixSuchen.setSearchString("Fix")
FixSuchen.setReplaceString("Fix ")
Fixrange.replaceAll(FixSuchen)

for i= 1 to2
FixSuchen.setSearchString("Fix  ")
FixSuchen.setReplaceString(" ")
Fixrange.replaceAll(FixSuchen)
next i

als erstes suche ich nach "Fixtermin" und änder es in "Fix<Leerzeichen>"
ebenso ändere ich "Fix" in "Fix<Leerzeichen>"
anschliessend lösche ich doppelte Leerzeichen nach dem "Fix" (2 mal)

Ziel davon ist, maximal 1 Leerzeichen nach dem Wort Fix zu erhalten.

Code: Alles auswählen

for zaehlen = 1 to 350

zellobjekt = Fixsheet.getcellrangebyname ("W" & zaehlen)
Zellinhalt = zellobjekt.string
inhaltlaenge = len(Zellinhalt)
IF inhaltlaenge < 9 then
Zellinhalt = zellinhalt & "xxxxxxxxxxxx"
end if

hier gehe ich sicher, daß der Zellinhalt alle meine "mid" Anweisungen befolgen kann

Code: Alles auswählen

Searchstring = "Fix"

'---Fix finden ----
test = instr(zellinhalt,searchstring) ' Suche Fix in Zellinhalt

test2 = mid(zellinhalt, (test+4), 5) ' Test2 beinhaltet nun 5 Zeichen nach dem Wort Fix+Leerzeichen

zielzelle1 = fixsheet.getcellrangebyname ("AJ" & zaehlen) ' hier wird der wert reingeschrieben

nun die Suche nach den Formatierungen :

Code: Alles auswählen

if instr(test2,":") > 0 then
c = mid(test2, instr(test2,":")+1)
test3 = val(test2)*10
test4 = val(c)/10
zielzelle1.value = (test3 + test4)/10

wenn also ein ":" vorkommt, ist C der inhalt des nachfolgenden Wertes
Test3 ist der Zahlenwert aus dem Text "00:00", irgendwie hab ich festgestellt, dass durch den ":" alle weiteren Zahlenwerte = 0 sind, also ist Test3 nur der Wert vor dem ":". Wert*10, da er vor dem Komma stehen soll
Test4 /10, da hinter dem Komma

Code: Alles auswählen

elseif instr(test2,",") > 0 then
 if val(test2) > 100 then
zielzelle1.value = val(test2)/100
 else
zielzelle1.value = val(test2)/10
 end if
else
zielzelle1.value = val(test2)
end if

next zaehlen

End Sub

der Rest sollte klar sein : 9,30 als Text ist 930 als Zahlwert, 16.30 ist 1630 usw.

gibt bestimmt Verbesserungen, aber : es funktioniert