从化学公式中提取数字

道歉，如果这已经被问及答复，但我找不到满意的答案。

我有一个化学公式列表，按顺序包括：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？

使用正则expression式

正则expression式 （正则expression式）这是一个很好的任务。 由于VBA不支持开箱即用的正则expression式，因此我们首先需要引用Windows库。

  1. 在工具然后引用添加引用正则expression式 在这里输入图像说明

  2. 并selectMicrosoft VBScript正则expression式5.5 在这里输入图像说明

  3. 将此function添加到模块 

     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

  4. 在单元格公式中使用这样的function

    例如在单元格B2中： =ChemRegex($A2,B$1)并将其复制到其他单元格 在这里输入图像说明

还要认识到有多种元素如CH3OH或CH3OH CH2COOH化学式

请注意，上面的代码不能像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或CaCl2化学式

除了以上多个元素出现的变化，使用这种模式： 

 strPattern = "([AZ][az]?)([0-9]*)" 'https://regex101.com/r/nNv8W6/2

在这里输入图像描述

  1. 请注意，他们需要在正确的大写/小写字母的情况下。 CaCl2工作，但不是cacl2或CACL2 。

  2. 请注意，如果这些字母组合是元素周期表的现有元素，这并不能certificate。 所以这也将认识到， 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.

这似乎工作得很好：

在这里输入图像说明

B2公式如下。 横向和纵向拖动 

 =IFERROR(IFERROR(--(MID($A2,SEARCH(B$1,$A2)+1,3)),IFERROR(--(MID($A2,SEARCH(B$1,$A2)+1,2)),--MID($A2,SEARCH(B$1,$A2)+1,1))),0)

或者是一个较短的数组公式，必须用ctrl + shift + enterinput 

 =MAX(IFERROR(--MID($A2,SEARCH(B$1,$A2)+1,ROW($A$1:$A$3)),0))

如果你想保持VBA超级简单，像这样的工作： 

 Public Function ElementCount(str As String, element As String) As Long Dim i As Integer Dim s As String For i = 1 To 3 s = Mid(str, InStr(str, element) + 1, i) On Error Resume Next ElementCount = CLng(s) On Error GoTo 0 Next i End Function

像这样使用它： 

 =ElementCount(A1,"C")

我在VBA中用正则expression式做了这个。 你也可以像Vityata所build议的那样通过循环string来实现，但是我怀疑这会稍微快一些，而且更容易阅读。 

 Option Explicit Function find_associated_number(chemical_formula As Range, element As String) As Variant Dim regex As Object: Set regex = CreateObject("VBScript.RegExp") Dim pattern As String Dim matches As Object If Len(element) > 1 Or chemical_formula.CountLarge <> 1 Then find_associated_number = CVErr(xlErrName) Else pattern = element + "(\d+)\D" With regex .pattern = pattern .ignorecase = True If .test(chemical_formula) Then Set matches = .Execute(chemical_formula) find_associated_number = matches(0).submatches(0) Else find_associated_number = CVErr(xlErrNA) End If End With End If End Function

然后，像平常一样在表格中使用公式：

在这里输入图像说明

列C包含碳primefaces的数目，列D包含氮primefaces的数目。 通过复制这个公式并改变它search的元素来扩展它。

使用VBA这是一个简单的任务 – 你必须遍历字符，并检查数值的值。 使用Excel，解决scheme包含一些冗余。 但这是可行的。 例如，

如果应用以下公式， C20H37NO5将返回20375 ： 

 =IF(ISNUMBER(1*MID(A1,1,1)),MID(A1,1,1),"")& IF(ISNUMBER(1*MID(A1,2,1)),MID(A1,2,1),"")& IF(ISNUMBER(1*MID(A1,3,1)),MID(A1,3,1),"")& IF(ISNUMBER(1*MID(A1,4,1)),MID(A1,4,1),"")& IF(ISNUMBER(1*MID(A1,5,1)),MID(A1,5,1),"")& IF(ISNUMBER(1*MID(A1,6,1)),MID(A1,6,1),"")& IF(ISNUMBER(1*MID(A1,7,1)),MID(A1,7,1),"")& IF(ISNUMBER(1*MID(A1,8,1)),MID(A1,8,1),"")& IF(ISNUMBER(1*MID(A1,9,1)),MID(A1,9,1),"")

目前，它检查前9个字符是数字。 如果要包含9个以上，则只需在公式中添加几行即可。

公式中有一个小窍门 – 1* 。 如果可能，它将文本字符转换为数字。 因此，作为文本的5乘以1成为数字字符。

使用拆分和类似的方法。 

 Sub test() Dim vDB As Variant, vR() As Variant Dim s As String Dim vSplit As Variant Dim i As Long, n As Long, j As Integer vDB = Range("a2", Range("a" & Rows.Count).End(xlUp)) n = UBound(vDB, 1) ReDim vR(1 To n, 1 To 4) For i = 1 To n s = vDB(i, 1) For j = 1 To Len(s) If Mid(s, j, 1) Like "[AZ]" Then s = Replace(s, Mid(s, j, 1), " ") End If Next j vSplit = Split(s, " ") For j = 1 To UBound(vSplit) vR(i, j) = vSplit(j) Next j Next i Range("b2").Resize(n, 4) = vR End Sub

如果你想要一个vba解决scheme来提取所有数字，我的首选解决scheme是使用正则expression式。 以下代码将从string中提取所有数字 

 Sub GetMolecularFormulaNumbers() Dim rng As Range Dim RegExp As Object Dim match, matches Dim j As Long Set rng = Range(Cells(1, 1), Cells(Cells(Rows.Count, 1).End(xlUp).Row, 1)) Set RegExp = CreateObject("vbscript.regexp") With RegExp .Pattern = "\d+" .IgnoreCase = True .Global = True For Each c In rng j = 0 Set matches = .Execute(c) If matches.Count > 0 Then For Each match In matches j = j + 1 c.Offset(0, j) = CInt(match) Next match End If Next c End With End Sub
    Interesting Posts

    使用Excel中的VBAmacros从NCI Chemical Identifier Resolver中检索化学结构的图像