Basic: String analysieren + Werte zuwesen

[F3K Total]

Hi,
ich habe da mal was gebastelt,
viel Spaß beim Studieren
Gruß R

[MH50]

Hey F3K Total! Das ist ja richtig gail! Ich werd mir das mal am WE genau zu Gemüte führen . Der erste Blick sieht sehr gut aus + hilft mir enorm weiter. 1000 Dank!

Sag mal, du liest die Werte ja aus einer Tabelle im selben Dokument aus. Es müsste doch sicher möglich sein, diese Tabelle in einem externen Dokument anzulegen und von dort aus einzulesen, oder? Ist das sehr viel aufwendiger? ich hab mal was von Verbindungen zu anderen Dokumenten gelesen, aber offen gestanden nur Bahnhof verstanden. Tja, bin halt noch ganz am Anfang (DAU-Gefahr! ).

Beste Grüße
MH50

[F3K Total]

Hi MH50,
klar geht das.
Allerdings ist mir nicht klar, was das Ziel dieser Aktion ist. Vielleicht solltest Du mal mitteilen woher welche Daten wie kommen, und was am Ende dabei herauskommen soll.
Gruß R

[MH50]

@ F3K Total: okay, am Ende soll das ganze ein Numerologieprogramm werden, also eine Namesanalyse nach einem uralten kabalistischen System. Stell dir das ein bisschen wie ein Astrologieprogramm vor: ich gebe Namen + Geburtsdatum in ein Textfeld im Writerdokument ein und das Programm errechnet daraus mehrere Zahlen, die eine Aussage über die Person zulassen. Diese Zahlen will ich dann mit Texten verknüpfen, die dann in das Writerdoc eingefügt werden sollen und ein mehrseitiges Textdokument ergeben. Daher die Idee das mit Basic und Writer zu lösen, da es am Ende um viel Text geht. Ich hatte mal einen Versuch mit Calc gestartet, aber das war super umständlich und mit den Texten landete ich komplett in der Pampa. Deswegen nun der neue Ansatz.

So, nun konkret: In dem fertigen Programm sieht man also nur das Writerdoc und einen Button zum starten der Makros. Die Wertetabelle soll gar nicht zu sehen sein. Es gibt 3 Eingabefelder: Vorname, Nachname und Geburtsdatum. Die Berechnungen mit dem Geburtsdatum funktionieren schon.
Nun wird jedem Buchstaben des vollen Namens eine spezielle Zahl zugeordnet, die der o.g. Wertetabelle entnommen wird. Soweit hattest du dein Code-Beispiel schon getrieben. Beim übernehmen und anpassen ist mir allerdings noch aufgefallen, dass ich ja noch ein paar Bedingungen abfragen muss. Beispiel: wenn der Name mit "Th" beginnt, wie bei Thomas, dann wird dem "Th" der Wert 22 zugewiesen. Das ist was anderes, als T + h (= 4+5=9). So eine Ausnahme gibts auch, wenn irgentwo ein "sch" auftaucht. Das erhält dann 18, oder ein "ck". Wie baut man das in deinen Code ein? Vielleicht mit Select Case?

Tja, es wird wieder komplizierter. Aber das Ganze ist ein Freizeitspaß und ich lerne obendrein ein bisschen Basic. .

Gruß
MH50

Ups, viel Text ...

[F3K Total]

Hi,
anbei nun eine Lösung ohne Tabelle, und mit der Möglichkeit nicht nur einzelne Buchstaben, sondern auch Ketten zu ersetzen.
Deine Zuordnung kannst Du jetzt direkt ins Makro eintippen.
Dabei ist es wichtig, das die Länge der Ketten im Makro von oben nach unten abnimmt. Es wird nämlich in dieser Reihenfolge nach den Buchstaben gesucht, und es sollte das "Sch" gefunden und durch eine Zahl ersetzt werden, bevor nach "S" oder "ch" gesucht wird.
Im Augenblick kann das Makro 29 Werte finden, wenn Du mehr brauchst ersetzte die "28" entsprechend.

Viel Erfolg
Gruß R

[MH50]

Wow! Werd ich heute abend testen. Vielen Dank erst mal.

Gruß
MH50

[MH50]

So, vom Prinzip her funtzt das schon mal. Ein "aber" ist allerdings schon wieder in Sicht....
Ich will aus den Ergebnissen eine Quersumme errechnen. Und genau da hakt es. die Quersummenberechnung an sich geht, aber einigen Zeichen-Ketten werden 2-stellige Zahlen (z.B. "Th" = 22) zugeordnet und das checkt das Makro nicht. Es macht aus 22 2+2=4. Das Ergebnis ist dann falsch. Da komm ich mal wieder nicht weiter.

Hier der Code (Dank F3K Total!, nur geringfügig angepasst):

Code: Alles auswählen

Sub string_to_Numbers_neu

oform = Thiscomponent.drawpage.forms.getbyname("Formular")
oVN = oform.getbyname("Textfeld1")'Eingabefeld
oNN = oform.getbyname("Textfeld2")'Ausgabefeld
sString=oVN.Text	'Vorname einlesen

dim kabal(1,33) as string	'Array mit "Ersetzungstabelle". Die längste Zeichenkette muss ganz am Anfang stehen!

kabal(0,0) = "SCH": kabal(1,0) = "18"
kabal(0,1) = "TH": kabal(1,1) = "22"
kabal(0,2) = "CK": kabal(1,2) = "4"
kabal(0,3) = "PH": kabal(1,3) = "17"
kabal(0,4) = "A": kabal(1,4) = "1"
kabal(0,5) = "B": kabal(1,5) = "2"
kabal(0,6) = "C": kabal(1,6) = "3"
kabal(0,7) = "D": kabal(1,7) = "4"
kabal(0,8) = "E": kabal(1,8) = "5"
kabal(0,9) = "F": kabal(1,9) = "8"
kabal(0,10) = "G": kabal(1,10) = "3"
kabal(0,11) = "H": kabal(1,11) = "5"
kabal(0,12) = "I": kabal(1,12) = "1"
kabal(0,13) = "J": kabal(1,13) = "1"
kabal(0,14) = "K": kabal(1,14) = "2"
kabal(0,15) = "L": kabal(1,15) = "3"
kabal(0,16) = "M": kabal(1,16) = "4"
kabal(0,17) = "N": kabal(1,17) = "5"
kabal(0,18) = "O": kabal(1,18) = "7"
kabal(0,19) = "P": kabal(1,19) = "8"
kabal(0,20) = "Q": kabal(1,20) = "1"
kabal(0,21) = "R": kabal(1,21) = "2"
kabal(0,22) = "S": kabal(1,22) = "3"
kabal(0,23) = "T": kabal(1,23) = "4"
kabal(0,24) = "U": kabal(1,24) = "6"
kabal(0,25) = "V": kabal(1,25) = "6"
kabal(0,26) = "W": kabal(1,26) = "6"
kabal(0,27) = "X": kabal(1,27) = "5"
kabal(0,28) = "Y": kabal(1,28) = "1"
kabal(0,29) = "Z": kabal(1,29) = "7"
kabal(0,30) = "Ä": kabal(1,30) = "6"
kabal(0,31) = "Ö": kabal(1,31) = "12"
kabal(0,32) = "Ü": kabal(1,32) = "11"
kabal(0,33) = "ß": kabal(1,33) = "6"

for i=0 to 33
sLetter=kabal(0,i)'Buchstabe/n auslesen
nStringlen=len(sLetter)'Länge
sNumber=kabal(1,i)'Zahl auslesen
	for k=1 to len(sString)
	npos = InStr(1, sString, sLetter,1 )
		if npos>0 then
		sString= Replace(sString,(mid(sString,npos,nStringlen)),sNumber)
		endif
	next k
next i

msgbox sString

Dim QSVName As Integer 
 	dim b as Integer
    dim String1 as String
    String1=CStr(sString)               'Eingabe in String umwandeln, um Anzahl der Stellen zu ermitteln und mit den Stellen zu rechnen
    for i=1 to len(String1)         'Anzahl Stellen bestimmt Anzahl Durchläufe
       b=b+CInt(mid(String1,i,1))   'Stelle für Stelle addieren
    next i
    QSVName=b 
    Print QSVName                    'Ergebnis zurückgeben

 'oTextfield2.Text=sString'Ergebnis ausgeben

End Sub

Hat jemand ne Idee?

Gruß
MH50

[MH50]

Tataaaa! Problem selbst gelöst .

Danke an alle

MH50

[F3K Total]

... und, wärst Du auch so freundlich uns an Deiner Lösung des Problemes teilhaben zu lassen?
Gruß R

[MH50]

Aber klar doch. Weiß nicht, ob meine Lösung besonders elegant ist, aber es geht.

Hier der Code:

Code: Alles auswählen

Sub CalcName

oform = Thiscomponent.drawpage.forms.getbyname("Formular")
oVN = oform.getbyname("Textfeld1")'Eingabefeld
oNN = oform.getbyname("Textfeld2")'Ausgabefeld
sString=oVN.Text+oNN.Text	'Vor- + Nachname einlesen

dim kabal(1,34) as string	'Array mit "Ersetzungstabelle". Die längste Zeichenkette muss ganz am Anfang stehen!

kabal(0,0) = "SCH": kabal(1,0) = "18"
kabal(0,1) = "TH": kabal(1,1) = "22"
kabal(0,2) = "CK": kabal(1,2) = "4"
kabal(0,3) = "PH": kabal(1,3) = "17"
kabal(0,4) = "A": kabal(1,4) = "1"
kabal(0,5) = "B": kabal(1,5) = "2"
kabal(0,6) = "C": kabal(1,6) = "3"
kabal(0,7) = "D": kabal(1,7) = "4"
kabal(0,8) = "E": kabal(1,8) = "5"
kabal(0,9) = "F": kabal(1,9) = "8"
kabal(0,10) = "G": kabal(1,10) = "3"
kabal(0,11) = "H": kabal(1,11) = "5"
kabal(0,12) = "I": kabal(1,12) = "1"
kabal(0,13) = "J": kabal(1,13) = "1"
kabal(0,14) = "K": kabal(1,14) = "2"
kabal(0,15) = "L": kabal(1,15) = "3"
kabal(0,16) = "M": kabal(1,16) = "4"
kabal(0,17) = "N": kabal(1,17) = "5"
kabal(0,18) = "O": kabal(1,18) = "7"
kabal(0,19) = "P": kabal(1,19) = "8"
kabal(0,20) = "Q": kabal(1,20) = "1"
kabal(0,21) = "R": kabal(1,21) = "2"
kabal(0,22) = "S": kabal(1,22) = "3"
kabal(0,23) = "T": kabal(1,23) = "4"
kabal(0,24) = "U": kabal(1,24) = "6"
kabal(0,25) = "V": kabal(1,25) = "6"
kabal(0,26) = "W": kabal(1,26) = "6"
kabal(0,27) = "X": kabal(1,27) = "5"
kabal(0,28) = "Y": kabal(1,28) = "1"
kabal(0,29) = "Z": kabal(1,29) = "7"
kabal(0,30) = "Ä": kabal(1,30) = "6"
kabal(0,31) = "Ö": kabal(1,31) = "12"
kabal(0,32) = "Ü": kabal(1,32) = "11"
kabal(0,33) = "ß": kabal(1,33) = "6"
kabal(0,34) = "-": kabal(1,34) = "0"

for i=0 to 34
sLetter=kabal(0,i)'Buchstabe/n auslesen
nStringlen=len(sLetter)'Länge
sNumber=kabal(1,i)&","       'Zahl auslesen + Komma dahinter setzen
	for k=1 to len(sString)
	npos = InStr(1, sString, sLetter,1 )
		if npos>0 then
		sString= Replace(sString,(mid(sString,npos,nStringlen)),sNumber)
		endif
	next k
next i

msgbox "Name übersetzt in Zahlen:"&Chr(13)& sString


Dim QSVName As Integer 
 	dim b as Integer
    dim String1 as String
    String1=CStr(sString)               'Eingabe in String umwandeln, um Anzahl der Stellen zu ermitteln und mit den Stellen zu rechnen
    ArrayStr1=split(sString,",")
    for i=0 to uBound(ArrayStr1)-1         'Anzahl Stellen bestimmt Anzahl Durchläufe
   	 b=b+CInt(ArrayStr1(i,0))   'Stelle für Stelle addieren
    next 
  
    QSVName=b 
    Print "Die Quersumme ist: "& QSVName                    'Ergebnis anzeigen

End Sub

Na, mal sehen, was die Profis dazu sagen.

Gruß
MH50

[DPunch]

Aloha

Warum addierst Du die Werte nicht einfach in dem Moment zusammen, wo Du sie Dir auch holst?

[Karolus]

Hallo

Warum addierst Du die Werte nicht einfach in dem Moment zusammen, wo Du sie Dir auch holst?

...Darüberhinaus könntest du in kabal auch gleich Zahlen eintragen ( ohne "") , und müsstest hinterher nicht x mal mit 'cint' umwandeln.

mit python könnte das etwa so aussehen:

Code: Alles auswählen

# -*- coding: utf-8 -*-
import re

Teststring = "Philiph Thomas Schumacker"

kabal = {"SCH":18,
         "TH":22,
         "CK":4,
         "PH":17,
         "A":1,
         "B":2,
         "C":3,
         "D":4,
         "E":5,
         "F":8,
         "G":3,
         "H":5,
         "I":1,
         "J":1,
         "K":2,
         "L":3,
         "M":4,
         "N":5,
         "O":7,
         "P":8,
         "Q":1,
         "R":2,
         "S":3,
         "T":4,
         "U":6,
         "V":6,
         "W":6,
         "X":5,
         "Y":1,
         "Z":7,
         "Ä":6,
         "Ö":12,
         "Ü":11,
         "ß":6  }

kabal_rex = re.compile( "SCH|TH|CK|PH|[A-ZÄÖÜẞ]" )

def kabal_liste( sname ):
    return [ kabal[elem] for elem in kabal_rex.findall( sname.upper() )]

def kabal_sum( Liste ):
    return sum ( Liste )

def test ( sname ):
    kliste = kabal_liste( sname )
    ksum = kabal_sum( kliste )
    print kliste, ksum

if __name__ == "__main__":
    test( Teststring )

[MH50]

Aloha

Warum addierst Du die Werte nicht einfach in dem Moment zusammen, wo Du sie Dir auch holst?

Ja schön, nur wie?

...Darüberhinaus könntest du in kabal auch gleich Zahlen eintragen ( ohne "") , und müsstest hinterher nicht x mal mit 'cint' umwandeln.

mit python könnte das etwa so aussehen:

anfängerfrage: hat python denn noch was mit Basic zu tun?

[DPunch]

Aloha

Ja schön, nur wie?

Da gibt es mehrere Wege. Der bequemste ist vermutlich der hier:

Code: Alles auswählen

Globalscope.BasicLibraries.loadLibrary("Tools")
nCrossTotal = 0
for i=0 to 34
	sLetter=kabal(0,i)'Buchstabe/n auslesen
	nCharVal = CInt(kabal(1,i)       'Zahl auslesen
	nCrossTotal = nCrossTotal + CountCharsInString(sString,sLetter,1)*nCharVal
	sString = Replace(sString,sLetter,(" " + nCharVal))
next i
MsgBox "Name übersetzt in Zahlen: " + sString + Chr(13) + "Quersumme: " + nCrossTotal

[MH50]

Hey DPunch, das sieht verdammt nach ner Abkürzung aus. Danke, werd ich am WE gleich ausprobieren. Sag mal, du beziehst dich aber auf das Array "kabal", so wie es im von mir vorgestellten Code steht, oder?

Gruß
MH50