vba - 从化学式中提取数字

抱歉，如果已经有人问过并回答了这个问题，但我找不到满意的答案。

我有一个化学式的列表，包括以下顺序: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？

最佳答案

使用正则表达式
对于regular expressions(正则表达式)，这是一项好任务。由于VBA不支持开箱即用的正则表达式，因此我们需要首先引用Windows库。

在“工具”下添加对regex的引用，然后在“引用”下添加

并选择Microsoft VBScript正则表达式5.5

将此功能添加到模块中

 Option Explicit

 Public Function ChemRegex(ChemFormula As String, 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被计数，最后一个被省略。
如果您还需要识别格式为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)₂之类的假体的化学式
因此，需要另一个RegEx来处理括号并将它们相乘。

Public Function ChemRegex(ChemFormula As String, 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

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