VBA Tipp: Molmasse errechnen

Aus DBWiki
Wechseln zu: Navigation, Suche

Aufgabenstellung

Ich suche eine Funktion, die mir aus der Summenformel einer Verbindung die Molmasse (veraltet bzw. falsch auch "Molekulargewicht" genannt) errechnet.

Lösung

Das leistet die folgende Funktion:

Option Compare Binary ' !!!
 
Public Function Molmasse(ByVal S As String) As Double
'
'  Parameter S: Summenformel als String
'  Rückgabewert: Molmasse
'
Dim I As Long, Ch As String, NextCh As String, Anzahl As String, Res As Double
Dim A As Variant, M As Variant, C As New Collection, Cnt() As Long, Ord As Long
 
  ' alle Elemente
  A = Array("H", "He", "Li", "Be", "B", "C", "N", "O", "F", "Ne", _
   "Na", "Mg", "Al", "Si", "P", "S", "Cl", "Ar", "K", "Ca", "Sc", "Ti", "V", _
   "Cr", "Mn", "Fe", "Co", "Ni", "Cu", "Zn", "Ga", "Ge", "As", "Se", "Br", _
   "Kr", "Rb", "Sr", "Y", "Zr", "Nb", "Mo", "Tc", "Ru", "Rh", "Pd", "Ag", _
   "Cd", "In", "Sn", "Sb", "Te", "I", "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", "Th", "Pa", "U", "Np", "Pu", "Am", _
   "Cm", "Bk", "Cf", "Es", "Fm", "Md", "No", "Lr")
  ' Atommassen
  M = Array(1.00794, 4.0026, 6.941, 9.01218, 10.81, 12.011, 14.0067, 15.9994, _
   18.9984, 20.1797, 22.98977, 24.305, 26.98154, 28.0855, 30.97376, 32.066, _
   35.4527, 39.948, 39.0983, 40.078, 44.9559, 47.88, 50.9415, 51.996, 54.93805, _
   55.847, 58.9332, 58.69, 63.546, 65.39, 69.723, 72.61, 74.9216, 78.96, 79.904, _
   83.8, 85.4678, 87.62, 88.90585, 91.224, 92.9064, 95.94, 97, 101.07, 102.905, _
   106.42, 107.8682, 112.41, 114.82, 118.71, 121.76, 127.6, 126.9045, 131.29, _
   132.9054, 137.33, 138.9055, 140.115, 140.908, 144.24, 145, 150.36, 151.96, _
   157.25, 158.92534, 162.5, 164.93, 167.26, 168.9342, 173.04, 174.967, 178.49, _
   180.9479, 183.84, 186.207, 190.23, 192.22, 195.08, 196.966, 200.59, 204.3833, _
   207.2, 208.9804, 209, 210, 222, 223, 226.0254, 227.028, 232.0381, 231.036, _
   238.0289, 237.0482, 242, 243, 247, 249, 251, 254, 253, 256, 259, 257)
 
' genauso groß wie A anlegen, hier werden die Anzahlen summiert:
  ReDim Cnt(LBound(A) To UBound(A))
 
  ' Collection erstellen
  For I = LBound(A) To UBound(A)
    C.Add I, A(I)
  Next I
 
  S = S & "XX"
  I = 1
  Ord = -1
 
  ' Summenformel zeichenweise abgrasen:
  Do Until I = Len(S)
    Ch = Mid(S, I, 1)
    NextCh = Mid(S, I + 1, 1)
    Err.Clear
    If Ch >= "A" And Ch <= "Z" Then
      If Ord >= 0 Then  ' wenn das Symbol für das Element gefunden wurde
        Cnt(Ord) = Cnt(Ord) + IIf(Anzahl = "", 1, Val(Anzahl)) ' Anzahl addieren
        Anzahl = ""
        Ord = -1
      End If
      If NextCh >= "a" And NextCh <= "z" Then
        ' gibt es ein passendes zweibuchstabiges Symbol?
        On Error Resume Next
        Ord = C(Ch & NextCh) ' Ordnungszahl ermitteln
        If Err.Number = 0 Then  ' - wenn es dieses Element gibt
          I = I + 1 ' ein zusätzliches Zeichen weitergehen
        End If
        On Error GoTo 0
      Else
        ' gibt es ein passendes einbuchstabiges Symbol?
        On Error Resume Next
        Ord = C(Ch)  ' Ordnungszahl ermitteln
        On Error GoTo 0
      End If
    ElseIf IsNumeric(Ch) Then ' keine Elementbezeichnung:
      Anzahl = Anzahl & Ch
    End If
    I = I + 1
  Loop
 
  ' Die Atommassen mit den Anzahlen multiplizieren und dann addieren:
  For I = LBound(A) To UBound(A)
    If Cnt(I) > 0 Then Res = Res + M(I) * Cnt(I)
  Next I
  Molmasse = Res
End Function

Aufruf

Debug.Print Molmasse("H2O") ' Wasser
 18,01528
Debug.Print Molmasse("C2H5OH") ' Ethanol
 46,06904