正如@Solar Mike 所指出的，最好将问题分解为多个部分——分而治之！下面的代码执行 2 个不同的步骤：1) 将化合物拆分为单独的元素和数量（使用我找到的函数 here）和 2) 计算化合物中所有元素的总重量。
代码假定您的数据位于工作簿的 sheet1 上，并且布局与您的图像显示的完全相同。它依赖于您在B 列中的元素列表以及它们在C 列中的质量（VLOOKUP() 范围来自B2:C120 - 您可能需要调整它）并且您的化合物从单元格@987654325 中列出@ 下。此外，代码要求列 G 到（右侧未知 - 取决于复合的复杂性）在代码执行期间可用，之后将被清除。
我相信会有比这更优雅的解决方案，但它确实适用于我的测试数据。请把下面的所有代码复制到一个标准模块（包括函数）中，让我知道它是怎么回事。
Option Explicit
Sub GetWeights()
Dim LastRow As Long, LastCol As Long, c As Range
Dim i As Integer, j As String, k As Double, weight As Double
'***Part 1 - split the formulas into separate columns
LastRow = Sheet1.Cells(Rows.Count, 5).End(xlUp).Row
With Sheet1.Range("F2:F" & LastRow)
.FormulaR1C1 = "=SepChem(RC5)"
.Value = .Value
End With
Application.DisplayAlerts = False
Sheet1.Range("F2:F" & LastRow).Select
Selection.TextToColumns Destination:=Range("F2"), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=True, Space:=True, FieldInfo _
:=Array(Array(1, 1), Array(2, 1), Array(3, 1), Array(4, 1), Array(5, 1), Array(6, 1)), _
TrailingMinusNumbers:=True
Application.DisplayAlerts = True
'***Part 2 - get the weights
LastRow = Sheet1.Cells(Rows.Count, 5).End(xlUp).Row
On Error GoTo Skip
For Each c In Sheet1.Range("F2:F" & LastRow)
If IsEmpty(c.Value) = True Or c.Value = "-" Then GoTo Skip
LastCol = c.End(xlToRight).Column - 1
For i = c.Column To LastCol Step 2
j = Cells(c.Row, i).Value
k = Application.VLookup(j, Sheet1.Range("B2:C120"), 2, False) _
* Cells(c.Row, i).Offset(0, 1).Value
weight = weight + k
Next i
c.Value = weight
weight = 0
Skip:
Next c
With Sheet1
LastCol = .Range("A1").SpecialCells(xlCellTypeLastCell).Column
End With
Sheet1.Range(Cells(2, 7), Cells(LastRow, LastCol)).ClearContents
End Sub
Public Function SepChem(ByVal s As String) As String
Static RegEx As Object
If RegEx Is Nothing Then
Set RegEx = CreateObject("VBScript.RegExp")
RegEx.Global = True
End If
With RegEx
.Pattern = "([a-zA-Z])(?=[A-Z]|$)"
s = .Replace(s, "$11")
.Pattern = "([a-zA-Z])(?=\d)|(\d)(?=[A-Z])"
SepChem = .Replace(s, "$1$2 ")
End With
End Function