Use Regular Expressions
This is a good task for regular expressions (regex). Because VBA doesn't support regular expressions out of the box we need to reference a Windows library first.
Add reference to regex under Tools then References
![enter image description here](https://i.stack.imgur.com/sKCdA.png)
and selecting Microsoft VBScript Regular Expression 5.5
![enter image description here](https://i.stack.imgur.com/nmSgP.png)
Add this function to a module
Option Explicit
Public Function ChemRegex(ByVal ChemFormula As String, ByVal Element As String) As Long
Dim strPattern As String
strPattern = "([CNHO])([0-9]*)"
'this pattern is limited to the elements C, N, H and O only.
Dim regEx As New RegExp
Dim Matches As MatchCollection, m As Match
If strPattern <> "" Then
With regEx
.Global = True
.MultiLine = True
.IgnoreCase = False
.Pattern = strPattern
End With
Set Matches = regEx.Execute(ChemFormula)
For Each m In Matches
If m.SubMatches(0) = Element Then
ChemRegex = IIf(Not m.SubMatches(1) = vbNullString, m.SubMatches(1), 1)
'this IIF ensures that in CH4O the C and O are count as 1
Exit For
End If
Next m
End If
End Function
Use the function like this in a cell formula
E.g. in cell B2: =ChemRegex($A2,B$1)
and copy it to the other cells
![enter image description here](https://i.stack.imgur.com/oOYT0.png)
Recognize also chemical formulas with multiple occurrences of elements like CH?OH
or CH?COOH
Note that the code above cannot count something like CH3OH
where elements occur more than once. Then only the first H3
is count the last is omitted.
If you need also to recognize formulas in the format like CH3OH
or CH2COOH
(and summarize the occurrences of the elements) then you need to change the code to recognize these too …
If m.SubMatches(0) = Element Then
ChemRegex = ChemRegex + IIf(Not m.SubMatches(1) = vbNullString, m.SubMatches(1), 1)
'Exit For needs to be removed.
End If
![enter image description here](https://i.stack.imgur.com/SUeXk.png)
Recognize also chemical formulas with 2 letter elements like NaOH
or CaCl?
In addition to the change above for multiple occurrences of elements use this pattern:
strPattern = "([A-Z][a-z]?)([0-9]*)" 'https://regex101.com/r/nNv8W6/2
![enter image description here](https://i.stack.imgur.com/kDjX7.png)
Note that they need to be in the correct upper/lower letter case. CaCl2
works but not cacl2
or CACL2
.
Note that this doesn't proof if these letter combinations are existing elements of the periodic table. So this will also recognize eg. Xx2Zz5Q
as fictive elements Xx = 2
, Zz = 5
and Q = 1
.
To accept only combinations that exist in the periodic table use the following pattern:
strPattern = "([A][cglmrstu]|[B][aehikr]?|[C][adeflmnorsu]?|[D][bsy]|[E][rsu]|[F][elmr]?|[G][ade]|[H][efgos]?|[I][nr]?|[K][r]?|[L][airuv]|[M][cdgnot]|[N][abdehiop]?|[O][gs]?|[P][abdmortu]?|[R][abefghnu]|[S][bcegimnr]?|[T][abcehilms]|[U]|[V]|[W]|[X][e]|[Y][b]?|[Z][nr])([0-9]*)"
'https://regex101.com/r/Hlzta2/3
'This pattern includes all 118 elements up to today.
'If new elements are found/generated by scientist they need to be added to the pattern.
Recognize also chemical formulas with prenthesis like Ca(OH)?
Therefore another RegEx is needed to handle the parenthesis and multiply them.
Public Function ChemRegex(ByVal ChemFormula As String, ByVal Element As String) As Long
Dim regEx As New RegExp
With regEx
.Global = True
.MultiLine = True
.IgnoreCase = False
End With
'first pattern matches every element once
regEx.Pattern = "([A][cglmrstu]|[B][aehikr]?|[C][adeflmnorsu]?|[D][bsy]|[E][rsu]|[F][elmr]?|[G][ade]|[H][efgos]?|[I][nr]?|[K][r]?|[L][airuv]|[M][cdgnot]|[N][abdehiop]?|[O][gs]?|[P][abdmortu]?|[R][abefghnu]|[S][bcegimnr]?|[T][abcehilms]|[U]|[V]|[W]|[X][e]|[Y][b]?|[Z][nr])([0-9]*)"
Dim Matches As MatchCollection
Set Matches = regEx.Execute(ChemFormula)
Dim m As Match
For Each m In Matches
If m.SubMatches(0) = Element Then
ChemRegex = ChemRegex + IIf(Not m.SubMatches(1) = vbNullString, m.SubMatches(1), 1)
End If
Next m
'second patternd finds parenthesis and multiplies elements within
regEx.Pattern = "(((.+?))([0-9]+)+)+?"
Set Matches = regEx.Execute(ChemFormula)
For Each m In Matches
ChemRegex = ChemRegex + ChemRegex(m.SubMatches(1), Element) * (m.SubMatches(2) - 1) '-1 because all elements were already counted once in the first pattern
Next m
End Function
This will also recognize parenthesis. Note that it does not recognize nested parenthesis.
![enter image description here](https://i.stack.imgur.com/9X9nJ.png)
与恶龙缠斗过久,自身亦成为恶龙;凝视深渊过久,深渊将回以凝视…