以上是2013年的时候写的一个宏,用于将溶剂的体积比转换成质量比,原来的博客页面找不到了,翻出来贴一下,方便新学习VBA使用的的朋友.

Public Sub 体积比to质量比()

    Dim CurSum As Double, tmpSum As Double, targetSum As Double, tmpStr As String, c As Range

    On Error GoTo theEnd

    If IsEmpty(Application.Selection) Then Exit Sub

    tmpStr = InputBox("将当前溶剂比例视为体积比,转换成质量比." & vbCrLf & "请输入质量比的总和", "体积比→质量比", "100%")

    If tmpStr = "" Then Exit Sub

    If Right(tmpStr, 1) = "%" Then

        targetSum = Val(Left(tmpStr, Len(tmpStr) - 1)) / 100

    Else

        targetSum = CDbl(tmpStr)

    End If

    CurSum = Application.WorksheetFunction.Sum(Application.Selection)

    '将每份体积乘以密度,得到单个质量,相加得到总质量数

    For Each c In Application.Selection

        tmpSum = tmpSum + c * GetSolvDensity(c.Offset(0, -1))

    Next c

    '将每份质量除以总质量,得到质量百分数,再乘以总目标数,得到目标百分比.

    For Each c In Application.Selection

        c = (c * GetSolvDensity(c.Offset(0, -1))) * targetSum / tmpSum

    Next c

theEnd:

End Sub

其中GetSolvDensity为自定义的获取溶剂密度的函数，如下：

这里为速度考虑，直接赋值。

Private Function GetSolvDensity(SolvName As String) As Double

    Select Case UCase(Trim(SolvName))

    Case "DMC": GetSolvDensity = 1.0698

    Case "EMC": GetSolvDensity = 1.0132

    Case "DEC": GetSolvDensity = 0.9747

    Case "EC": GetSolvDensity = 1.37

    Case "PC": GetSolvDensity = 1.205

    Case "FEC": GetSolvDensity = 1.497

    Case "FB": GetSolvDensity = 1.024

    Case "EA": GetSolvDensity = 0.902

    Case "GBL": GetSolvDensity = 1.129

    Case "MPC": GetSolvDensity = 0.98

    Case "EP": GetSolvDensity = 0.888

    Case "MA": GetSolvDensity = 0.93

    Case "BC": GetSolvDensity = 1.1442

    Case "PA": GetSolvDensity = 0.8878

    Case "MP": GetSolvDensity = 0.915

    Case "MB": GetSolvDensity = 0.898

    Case Else

        MsgBox "新溶剂" & UCase(SolvName) & "未在代码中设定密度."

        GetSolvDensity = 0

    End Select

End Function

演示的例子

工作簿1.rar