vba - 从化学式中提取数字

Question

抱歉，如果这已经被问到并回答了，但我找不到令人满意的答案。
我有一个化学式列表，按以下顺序排列:C、H、N 和 O。我想在每个字母后面加上数字。问题是并非所有公式都包含 N。然而，所有公式都包含 C、H 和 O。数字可以是单数、双数或(仅在 H 的情况下)三位数。
因此数据看起来像这样:

C20H37N1O5

C10H12O3

C20H19N3O4

C23H40O3

C9H13N1O3

C14H26O4

C58H100N2O9

我希望列表中的每个元素编号在单独的列中。所以在第一个例子中它将是:

20 37 1 5

我一直在尝试:

=IFERROR(MID(LEFT(A2,FIND("H",A2)-1),FIND("C",A2)+1,LEN(A2)),"") 

分离出C#。然而，在这之后我被卡住了，因为 H# 的两侧是 O 或 N。
有没有可以做到这一点的excel公式或VBA？

Answer 1

使用正则表达式
这对 regular expressions 来说是个好任务(正则表达式)。因为 VBA 不支持开箱即用的正则表达式，所以我们需要先引用一个 Windows 库。

在 Tools 然后 References 下添加对正则表达式的引用

并选择 Microsoft VBScript 正则表达式 5.5

将此功能添加到模块

 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

在单元格公式中使用这样的函数
例如。在单元格 B2 中:=ChemRegex($A2,B$1)并将其复制到其他单元格

还可以识别具有多次出现的元素的化学式，例如 CH₃OH或 CH₂COOH请注意，上面的代码不能计算 CH3OH其中元素出现不止一次。那么只有第一个 H3 is count 最后一个被省略。
如果您还需要识别格式如 CH3OH 的公式或 CH2COOH (并总结元素的出现)然后您需要更改代码以识别这些...

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

还可以识别带有 2 个字母元素的化学式，例如 NaOH或 CaCl₂除了上述对多次出现的元素的更改之外，还使用此模式:

strPattern = "([A-Z][a-z]?)([0-9]*)"   'https://regex101.com/r/nNv8W6/2

请注意，它们需要使用正确的大写/小写字母。 CaCl2有效但无效 cacl2或 CACL2 .

请注意，这并不能证明这些字母组合是否是元素周期表中的现有元素。所以这也将识别例如。 Xx2Zz5Q作为虚构元素Xx = 2 , Zz = 5和 Q = 1 .
要仅接受元素周期表中存在的组合，请使用以下模式:

 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.

还可以识别带有 Ca(OH)₂ 等前缀的化学式
因此需要另一个正则表达式来处理括号并将它们相乘。

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

这也将识别括号。请注意，它不识别嵌套括号。


也看看一个类似的问题: Determine total number of atoms in a chemical formula