如何加快从化学式中提取数字

Posted 2023-03-27

【中文标题】如何加快从化学式中提取数字

【英文标题】：How to speed up extracting numbers from chemical formula

【发布时间】：2022-01-15 01:09:08

【问题描述】：

我一直在使用 PEH 提供的一些有用的 VBA 代码，它使用正则表达式来提取化学式中特定元素的实例数，请参阅：https://***.com/a/46091904/17194644

它运行良好，但是当我在一个工作表中使用该函数数百次时，一切都会变慢。我想知道这是否可能是由于 VBA 从/向单元格读取/写入值所花费的时间，所以我创建了一个数组函数（基于 PEH 的正则表达式代码）以查看它是否会加快速度，请参阅以下。该函数可以工作并且速度更快，但在处理数百个值时仍然会减慢速度，并且我无法让第二部分工作，即在括号内找到乘法元素。关于如何进一步改进的想法？

Function CountElements(ChemFormulaRange As Variant, ElementRange As Variant) As Variant

'define variables
Dim RetValRange() As Long
Dim RetVal As Long
Dim ChemFormula As String
Dim npoints As Long
Dim i As Long
Dim mpoints As Long
Dim j As Long

' Convert input ranges to variant arrays
If TypeName(ChemFormulaRange) = "Range" Then ChemFormulaRange = ChemFormulaRange.Value
If TypeName(ElementRange) = "Range" Then ElementRange = ElementRange.Value

'parameter
npoints = UBound(ChemFormulaRange, 1) - LBound(ChemFormulaRange, 1) + 1
mpoints = UBound(ElementRange, 2) - LBound(ElementRange, 2) + 1

'dimension arrays
ReDim RetValRange(1 To npoints, 1 To mpoints)

'calculate all values
For j = 1 To mpoints
Element = ElementRange(1, j)
For i = 1 To npoints
RetVal = 0
ChemFormula = ChemFormulaRange(i, 1)
Call ChemRegex(ChemFormula, Element, RetVal)
RetValRange(i, j) = RetVal
Next i
Next j

'output answer
CountElements = RetValRange

End Function
Private Sub ChemRegex(ChemFormula, Element, RetVal)
    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
            RetVal = RetVal + 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
'        RetVal = RetVal + ChemFormula(m.SubMatches(1), Element) * (m.SubMatches(2) - 1) '-1 because all elements were already counted once in the first pattern
'    Next m
End Sub

【问题讨论】：

那么问题出在哪里？代码执行缓慢或提取某些特定数据？

代码执行慢

仅供参考：正则表达式构建得非常好，每个替代匹配字符串内的不同位置。

【参考方案1】：

如果您使用的是 Office 365，则不需要 VBA。一个公式可以实现你想要的，我认为它会更快。

=TRIM(TEXTJOIN("",TRUE,IFERROR((MID(A1,ROW(INDIRECT("1:"&LEN(A1))),1)*1)," ")))

注意：如果您还需要VBA解决方案，请记住您可以一次性输入整个范围内的上述公式，然后将其转换为值。

rng.Formula = "=TRIM(TEXTJOIN("""",TRUE,IFERROR((MID(A1,ROW(INDIRECT(""1:""&LEN(A1))),1)*1),"" "")))"
rng.Value = rng.Value

【讨论】：

很好的解决方案 +:) - 仅供参考，基于单个数组比较发布了一个可能的溢出范围输出的替代方案。

【参考方案2】：

ChemRegex 例程中最慢的部分是创建 RegExp 对象。

如果将所有单元格作为一对大区域传递给 CountElements，则移动创建 RegExp 对象并将一些属性从 ChemRegex 应用到 CountElements 的代码，并将 RegExp 引用从 CountElements 传递给 ChemRegex。

或者，如果您在多个单元格中调用 CountElements 作为 UDF，请在模块级别声明 RegExp

Private RegEx as RegExp

在 CountElements 中...

If RegEx is Nothing Then
    Set RegEx = New RegExp
    ' apply the properties
End If
' code
' and pass RegEx to ChemRegex
Call ChemRegex(ChemFormula, Element, RetVal, RegEx)

【参考方案3】：

分离化学式中的所有数字

为了艺术，Siddharth 的方法的替代方案，我在其中演示如何使用Match() 比较

给定字符串中每个公式字符|数字的数组 所有常规数字的数组。

这允许根据它们的位置来识别数组元素（这里：数字）。所以这个演示可能也有助于解决类似的需求。 - 我不会假装这是一个更好或更快的方法。

Function ChemNo(ByVal s As String) As Variant
'Purp: return array of found character positions in chars string
'Note: (non-findings show Error 2042; can be identified by IsError + Not IsNumeric)
    Dim digits
    digits = String2Arr("1234567890")
    'get any digit position within array digits     ' note: zero position returns 10
    Dim tmp
    tmp = Application.Match(String2Arr(s), digits, 0)
    'check for digits in a loop through tmp
    Dim i As Long, ii As Long
    For i = 1 To UBound(tmp)
        If IsNumeric(tmp(i)) Then                   ' found digit
            tmp(i) = tmp(i) Mod 10                  ' get digtis including zeros
            If IsNumeric(tmp(i - 1)) Then           ' check preceding digit
                tmp(i) = 10 * tmp(i - 1) + tmp(i)   ' complete number
                tmp(i - 1) = "!"                    ' mark former digit
            End If
        Else
            tmp(i) = "!"                            ' mark non-numeric element
        End If
    Next i
    
    ChemNo = Filter(tmp, "!", False)                ' delete marked elements
End Function

帮助功能String2Arr()

在原子化字符串输入后分配单个字符数组：

Function String2Arr(ByVal s As String) As Variant
'Purp: return array of all single characters in a string
'Idea: https://***.com/questions/13195583/split-string-into-array-of-characters
    s = StrConv(s, vbUnicode)
    String2Arr = Split(s, vbNullChar, Len(s) \ 2)
End Function

如果您想将该函数用作表格输入以利用 Excel 中较新的动态功能，您可以将其输入为用户定义的函数，例如在单元格B1：=ChemNo(A1) 中水平显示每个数字，即所谓的溢出范围。 使用旧版本，我想你需要一个 CSE 条目 (Ctrl↑┘)将其标记为 array 公式。