excel - 如何使用元素周期表对化合物求和(化学课)

Question

我有两个不同的表；一个是元素周期表 (PSE) 列 A-C 及其各自的原子质量，另一个表列 E-F 与我需要计算/求和总质量但使用第一个表作为来源的化合物一致。因此，例如，化合物 H2O(水)总计为 18 g/mol(H=1x2，O=16)...但是有像 C6H6Zn 这样的化合物或前面有更多数字的化合物，这让我很难理解如何计算/总结它们。 H 列是我需要获取的实际值。

我希望有人能以某种方式帮助我，至少是任何类型的输入..

Answer 1

正如@Solar Mike 指出的那样，最好将问题分解成多个部分——分而治之!下面的代码执行 2 个不同的步骤:1) 将化合物分成单独的元素和数量(使用我发现的函数 here )和 2) 计算化合物中所有元素的总重量。

该代码假定您的数据位于工作簿的 sheet1 上，并且布局与您的图像显示的完全相同。它依赖于 B 列中的元素列表及其在 C 列中的质量(VLOOKUP() 范围来自 B2:C120 -您可能需要对其进行调整)并且您的化合物列在单元格 E2 下方。此外，该代码要求列 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