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

如何解决如何使用元素周期表求和化合物化学课

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

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

解决方法

正如@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,Array(3,Array(4,Array(5,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