以上是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
标签: 溶剂
