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 in einem allgemeinen VBA-Modul:

Public Function MolMasse(ByVal s As String) As Double
 
   'Parameter s: Summenformel als String
   'Rückgabewert: Molmasse
 
   'Quelle: http://www.dbwiki.net/
 
 
   Static a   As Variant
   Static m   As Variant
   Static c   As Collection
 
   Dim ch     As String
   Dim nextCh As String
   Dim anzahl As String
   Dim res    As Double
   Dim cnt()  As Long
   Dim ord    As Long
   Dim i      As Long
 
   If c Is Nothing Then
      ' 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)
 
      'Collection erstellen
      Set c = New VBA.Collection
      For i = 0 To UBound(a)
         c.Add i, a(i)
      Next
   End If
 
   'genauso groß wie a anlegen; hier werden die Anzahlen summiert:
   ReDim cnt(UBound(a))
 
   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)
      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 = vbNullString, 1, Val(anzahl))   'Anzahl addieren
            anzahl = vbNullString
            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 = 0 To UBound(m)
      If cnt(i) > 0 Then res = res + m(i) * cnt(i)
   Next
 
   MolMasse = res
 
End Function

Aufruf

im VBA-Direktfenster:

?Molmasse("H2O") ' Wasser
 18,01528
 
?Molmasse("C2H5OH") ' Ethanol
 46,06904