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

Question

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

​

​

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

Answer 1

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

代码假定您的数据位于工作簿的sheet1上，并且布局与图像显示的完全相同。它依赖于您的元素列表在B列中，它们的质量在C列中( VLOOKUP()范围来自B2:C120 -您可能想要调整它)，并且您的化合物从单元格E2向下列出。此外，代码要求列G to (右侧未知-取决于复合的复杂性)在代码执行期间可用，之后将被清除。

我确信会有比这更好的解决方案，但它确实适用于我的测试数据。请将下面的所有代码复制到一个标准模块(包括函数)，并让我知道它是如何进行的。

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