On Thu, 15 Dec 2005 14:00:28 +0100, you wrote:
Hallo Heinz,
>Ich hab mir hier mit Hilfe von ->Makro aufzeichnen ,
>und (weitesgehend) mit Suchen und Ersetzen ein Makro
>gebaut, das Textstrings in der Form von chemischen Summenformeln,
>zb.CaCO3, NaCl oder NH4Fe(SO4)2,
>in eine scalc-Funktion umstrukturiert,die dann im Tabellenblatt
>ausgewertet wird; d.h. zu einer chem. Summenformel wird das
>entsprechende Molekularewicht errechnet.
ich hatte sowas mal als XL-Funktion geschrieben, aber nur ein paar
Elemente eingebaut und hab jetzt Deine Liste verwendet :-) Danke schön
dafür. Das ist eine Arrayfunktion über zwei Zellen in Zeile. Die erste
liefert das Summen-Ergebnis und die zweite den Formelstring.
Unter OO-Basic muss man die Funktionen Replace und Evaluate
nachbilden. Falls Dir dazu nix einfällt, dann melde Dich unter PM -
kann ich Dir zukommen lassen...
BTW: Bei Deiner Lösung wäre es effektiver EINEN Argument-Array zu
verwenden und immer nur die Seach/Replace-Terme auszutauschen...
Gruß HW
--
Hans Werner Hofmann
'--------------------------Mol.bas ---------------------------
'Rechner für die Elementaranalyse und Molmassen-Berechnung
'Berechnet Molmassen und (die Massenanteile der Elemente in %)
'aus der Summenformel. Anpassung MolGewicht.xls nach oo BASIC
'Replace und Evaluate nachgebildet/angepasst! (2005 hw)
'-------------------------------------------------------------
'(C)oded 2004 hw::lemitec.de
Function Molgewicht(formel As String)
'formel="K3(Fe(CN)5NO)"
Const DIGIT = "1234567890"
Dim A, B, C As Variant
Dim i As Integer
A = Array("H", "He", "Li", "Be", "B", "C", "N", "O", "F", "Ne", "Na",
"Mg", "Al", "Si", _
"P", "S", "Cl", "K", "Ar", "Ca", "Sc", "Ti", "V", "Cr", "Mn", "Fe",
"Ni", "Co", "Cu", _
"Zn", "Ga", "Ge", "As", "Se", "Br", "Kr", "Rb", "Sr", "Y", "Zr", "Nb",
"Mo", _
"Tc", "Ru", "Rh", "Pd", "Ag", "Cd", "In", "Sn", "Sb", "I", "Te", "Xe",
"Cs", "Ba", _
"La", "Ce", "Pr", "Nd", "Pm", "Sm", "Eu", "Gd", "Tb", "Dy", "Ho",
"Er", "Tm", _
"Yb", "Lu", "Hf", "Ta", "W", "Re", "Os", "Ir", "Pt", "Au", "Hg", "Tl",
"Pb", "Bi", _
"Po", "At", "Rn", "Fr", "Ra", "Ac", "Pa", "Th", "Np", "U", "Am", "Pu",
"Cm", "Bk", _
"Cf", "Es", "Fm", "Md", "No", "Lr", "Rf", "Db", "Bh", "Sg", "Hs",
"Mt")
C = Array(1.01, 4, 6.94, 9.01, 10.81, 12.01, 14.01, 16, 19, 20.18,
22.99, 24.31, 26.98, 28.09, 30.97, _
32.07, 35.45, 39.1, 39.95, 40.08, 44.96, 47.88, 50.94, 52, 54.94,
55.85, 58.69, 58.93, 63.55, 65.39, _
69.72, 72.61, 74.92, 78.96, 79.9, 83.8, 85.47, 87.62, 88.91, 91.22,
92.91, 95.94, 98.91, 101.07, 102.91, _
106.42, 107.87, 112.41, 114.82, 118.71, 121.75, 126.9, 127.6, 131.29,
132.91, 137.33, 138.91, 140.12, _
140.91, 144.24, 146.92, 150.36, 151.97, 157.25, 158.93, 162.5, 164.93,
167.26, 168.93, 173.04, 174.97, _
178.49, 180.95, 183.85, 186.21, 190.2, 192.22, 195.08, 196.97, 200.59,
204.38, 207.2, 208.98, 208.98, _
209.99, 222.02, 223.02, 226.03, 227.03, 231.04, 232.04, 237.05,
238.03, 243.06, 244.06, 247.07, _
247.07, 251.08, 252.08, 257.1, 258.1, 259.1, 260.11, 261.11, 262.11,
262.12, 263.12, 265, 266)
If formel = "" Then Exit Function
i = 1: While i <= Len(formel)
If InStr(DIGIT, Mid(formel, i, 1)) > 0 Then
formel = Left(formel, i - 1) & "*" & Mid(formel, i): i = i + 1
While InStr(DIGIT, Mid(formel, i, 1)) > 0 And i <=
Len(formel): i = i + 1: Wend
Else
i = i + 1
End If
Wend
For i = 108 To 0 Step -1
If Instr(formel, A(i)) > 0 then
formel = Replace(formel, A(i), "+" & C(i))
End If
Next
formel = Trim(Replace(formel, "(+", "+("))
If Left(formel, 1) < "1" Then formel = Mid(formel, 2)
'Evaluate - Math Parser not included in oo BASIC (Parser.bas)
Molgewicht = Array(Evaluate(formel,0,i),formel)
End Function
Function Replace( t as String, p as String, s as String) as String
Dim oFunktion as Object
Dim aArgumente(2) As String
' com.sun.star.sheet.FunctionAccess holen
oFunktion = createUnoService("com.sun.star.sheet.FunctionAccess")
aArgumente(0) = t
aArgumente(1) = p
aArgumente(2) = s
Replace = oFunktion.callFunction( "SUBSTITUTE", aArgumente() )
End Function
---------------------------------------------------------------------
To unsubscribe, e-mail: [EMAIL PROTECTED]
For additional commands, e-mail: [EMAIL PROTECTED]
