这个脚本比起昨天的脚本来，已经不可同日而语了。这个脚本已经是全功能的自动处理脚本了，解决了如下几个大问题：
1. 解决处理的数据组数8组的限制问题，现在这个组数可以由你来决定；
2. 完全重写数据处理部分内容，虽然限制了处理数据的组数在5-10组之间，但是可以随时进行扩充；
3. 重新调整数据输出格式，增加了一定的可扩展性；
4. 增加了多个变量和多个数据输入区域，这样你可以定制更多的参数，增加了灵活性；
5. 已经解决了曲线拟合只能在sheet1中的限制；
TODO:
1. 增加另外两种作图方法（即求CD的包合常数的方法）；
2. 将初始化表格的那个宏添加到表格加载的事件中
3. 对脚本进行优化
4. 将半自动计算IC的Sub自动化
5. 在表格输出结果的格式上作一些小改动
6. 开始着手用其他语言改写这个脚本
7. 增加异常处理模块
虽然写脚本的时候是一边看资料，一边写的，不过写了这么长长的一堆还是挺有成就感的。
（绝大多数都是自己用键盘敲出来的哦，可不像昨天的那个脚本，几乎全是自动录制的宏。
）VB已经是忘记的一干二净了，不过，因为现在学到了很多以前不懂的东西，重新接触VB感觉已经和当初不大一样了。我编程的速度一向比较慢，但是因为这不是什么考试，所以也不需要很快，就当是一种娱乐了，哈哈。
OK，献上脚本。
授权吗？嗨，这种脚本就放在公有域了。(Public Domain，反正你也不知道我的名字，而且这个脚本对你一点用都没有。
)Attribute VB_Name = "模块1"
'
' 作者: 我
' 日期: 2006年8月14日
' 版本: 0.1.0
'
' 用途: 环糊精包合常数自动计算脚本
'
' ChangeLog:
' 0.0.1 完成计算脚本的大体框架
' 0.1.0 重新格式化输出结果表格格式，完全重写数值计算部分代码，增加多个变量
'
'
'
' TODO:
' 1. 增加另外两种作图方法（即求CD的包合常数的方法）；
' 2. 将初始化表格的那个宏添加到表格加载的事件中
' 3. 对脚本进行优化
' 4. 将半自动计算IC的Sub自动化
' 5. 在表格输出结果的格式上作一些小改动
' 6. 开始着手用其他语言改写这个脚本
' 7. 增加异常处理模块
'
'
'
' 生成格式固定的表格
'
Sub Init_Tbl()
'
' 这个过程将被添加到空白表格的加载事件中
' Init_Input Macro
' 初始化表格，等待用户输入吸光值（A0-An）、环糊精质量（mCD）和环糊精平均分子量（MCD）
' 以及其他的额外数据
'
'
' 用户输入区。包括部分数据输出区。
'
Range("B2").Select
ActiveCell.FormulaR1C1 = "波长(nm)"
Range("D2").Select
ActiveCell.FormulaR1C1 = "CD类型"
Range("F2").Select
ActiveCell.FormulaR1C1 = "pH"
Range("H2").Select
ActiveCell.FormulaR1C1 = "定容体积(mL)"
Range("I2").Select
ActiveCell.FormulaR1C1 = "10" ' 如果用户不修改这个数，将不作修改，大多数情况下，这个数值是正确的
Range("B3").Select
ActiveCell.FormulaR1C1 = "注射针数"
Range("D3").Select
ActiveCell.FormulaR1C1 = "每针剂量(μL)"
Range("F3").Select
ActiveCell.FormulaR1C1 = "原始剂量(mL)"
Range("G3").Select
ActiveCell.FormulaR1C1 = "2.5" ' 如果用户不修改这个数，将不作修改，大多数情况下，这个数值是正确的
Range("B4").Select
ActiveCell.FormulaR1C1 = "A0 -> An"
Range("B5").Select
ActiveCell.FormulaR1C1 = "CD质量(g)"
Range("B6").Select
ActiveCell.FormulaR1C1 = "CD摩尔质量(g/mol)"
Range("B7").Select
ActiveCell.FormulaR1C1 = "CD物质的量(mol)"
Range("B11").Select
ActiveCell.FormulaR1C1 = "包合常数(1/mol)"
Range("F7").Select
ActiveCell.FormulaR1C1 = "溶剂"
Range("G7").Select
ActiveCell.FormulaR1C1 = "水"
Range("H7").Select
ActiveCell.FormulaR1C1 = "药物名"
Range("I7").Select
ActiveCell.FormulaR1C1 = "某药"
'
' 生成表格主体格式 （不包括组号）
'
Range("C13").Select
ActiveCell.FormulaR1C1 = "A"
Range("D13").Select
ActiveCell.FormulaR1C1 = "[CD](mol/L)"
Range("E13").Select
ActiveCell.FormulaR1C1 = "1/[CD]"
Range("F13").Select
ActiveCell.FormulaR1C1 = "1/(A-A0)"
Range("G13").Select
ActiveCell.FormulaR1C1 = "A-A0"
Range("H13").Select
ActiveCell.FormulaR1C1 = "[CD]/(A-A0)"
End Sub
Sub Data_Proc_All()
'
' 变量定义部分
'
Dim m_cd As String '定义CD物质的质量，即称量质量
Dim mw_cd As String '定义CD的分子量，即摩尔质量
Dim n_cd As Double '定义CD物质的量，即质量/分子量
Dim wl As String '定义波长，即选取数据的波长，一般为波峰处
Dim t_cd As String '定义CD名称。以后使用固定CD名，添加根据CD名称确定CD分子量的代码块
Dim ph As String '定义pH，用途暂时未明确
Dim n_inj As String '定义注射次数
Dim a_inj As String '定义每针剂量
Dim a_ori As String '定义原始剂量，即，打针前注入比色皿的液体体积，一般为2.5mL
Dim v_cst As String '定义定容体积，即，实验使用的容量瓶体积（药品溶液定容CD的定容体积）
Dim tmp_msg As Integer '定义消息框临时变量
'
' 变量赋值部分
'
' 用户输入部分变量赋值，除吸光值外。吸光值输入将在表格填充，即数据处理部分完成。
'
Range("C5").Select
m_cd = ActiveCell.Value
Range("C6").Select
mw_cd = ActiveCell.Value
n_cd = (m_cd / mw_cd)
Range("C2").Select
wl = ActiveCell.Value
Range("E2").Select
t_cd = ActiveCell.Value
Range("G2").Select
ph = ActiveCell.Value
Range("I2").Select
v_cst = ActiveCell.Value
Range("C3").Select
n_inj = ActiveCell.Value
Range("E3").Select
a_inj = ActiveCell.Value
Range("G3").Select
a_ori = ActiveCell.Value
'
' 数据处理部分
'
' 填充数据：组号和吸光值
'
'
' 定义变量
'
Dim rng_no As String '定义组号单元格位置
Dim rng_cntr As Integer '计数器临时变量
Dim rng_a_ori As String '复制源吸光值的单元格位置
Dim rng_a_dst As String '复制到吸光值的单元格位置
Dim tmp_a As String '吸光值值传递中介
Dim rng_cd As String '体系的环糊精浓度
Dim tmp_cd As String '在[CD]到1/[CD]之间传递数值
Dim rng_cd_re As String '定义1/[CD]的单元格位置
Dim a_blnk As String '定义A0的值,也算是临时变量吧。
Dim rng_dlt_a As String '定义A-A0的单元格位置
Dim rng_dlt_a_re As String '定义1/(A-A0)的单元格位置
Dim rng_cd_dlt_a As String '定义[CD]/(A-A0)的单元格位置
rng_cntr = 0 '计数器初始化
'
' 填充CD的物质的量的值
'
Range("C7").Select
ActiveCell.Value = n_cd
'
' 为a_blnk赋A0的值
'
Range("C4").Select
a_blnk = ActiveCell.Value
'
' 计算表格中各种数据的循环
' 已经完全替换自动填充代码
'
For rng_cntr = 0 To n_inj
'
'各组运算值的单元格位置赋值
'
rng_no = "B" & (14 + rng_cntr)
rng_a_ori = Chr(Asc("C") + rng_cntr) & "4"
rng_a_dst = "C" & (14 + rng_cntr)
rng_cd = "D" & (14 + rng_cntr)
rng_cd_re = "E" & (14 + rng_cntr)
rng_dlt_a = "G" & (14 + rng_cntr)
rng_dlt_a_re = "F" & (14 + rng_cntr)
rng_cd_dlt_a = "H" & (14 + rng_cntr)
'
' 填充组号
'
Range(rng_no).Select
ActiveCell.Value = rng_cntr
'
' 复制吸光值到目标单元格
'
Range(rng_a_ori).Select
tmp_a = ActiveCell.Value
Range(rng_a_dst).Select
ActiveCell.Value = tmp_a
'
' 主算法部分[CD],1/[CD]
'
'
' [CD]的值
'
Range(rng_cd).Select
ActiveCell.Value = ((n_cd / (v_cst * 1e-3)) * a_inj * 1e-6 * rng_cntr) / ((a_ori + (a_inj * 1e-3 * rng_cntr)) * 1e-3)
tmp_cd = ActiveCell.Value
If ActiveCell.Value = "0" Then
'
' 表格结果区处A0外的第一行留空
'
ActiveCell.Value = ""
Range(rng_cd_re).Select
ActiveCell.Value = ""
Range(rng_dlt_a).Select
ActiveCell.Value = ""
Range(rng_dlt_a_re).Select
ActiveCell.Value = ""
Range(rng_cd_dlt_a).Select
ActiveCell.Value = ""
Else
'
' 1/[CD]的值
'
Range(rng_cd_re).Select
ActiveCell.Value = 1 / tmp_cd
'
' A-A0,1/(A-A0),[CD]/A-A0的值
'
Range(rng_dlt_a).Select
ActiveCell.Value = tmp_a - a_blnk ' A-A0的值
Range(rng_dlt_a_re).Select
ActiveCell.Value = 1 / (tmp_a - a_blnk) ' 1/(A-A0)的值
Range(rng_cd_dlt_a).Select
ActiveCell.Value = tmp_cd / (tmp_a - a_blnk) ' [CD]/(A-A0)的值
End If
Next
'
'
' 生成结果表格的名称
'
'
Dim slv_nm As String '定义溶剂名，默认是"水"
Dim drg_nm As String '定义药物名，默认是"某药"
Range("G7").Select
slv_nm = ActiveCell.Value
Range("I7").Select
drg_nm = ActiveCell.Value
Range("D1:I1").Select
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = True
End With
Range("D1:I1").Select
ActiveCell.Value = t_cd & "在pH" & ph & "的" & slv_nm & "溶液体系中对" & drg_nm & "的包合常数 (" & wl & "nm)"
'
'
' 数据拟合部分
' 即：作图
'
'
'
' 为了使作图功能在不同工作表中都可以使用，现在将常量：工作表名替换为变量
'
'
Dim sht_nm As String
sht_nm = ActiveSheet.Name
'
'
' 对不同的注射次数选择不同的数据区域。
'
' 我汗，居然一定要3行一起放在选择结构里面
' 而且好像作图还是有时成功，有时失败的，晕死！
'
Select Case n_inj
Case "5"
Range("E15:F19").Select
Charts.Add
ActiveChart.ChartType = xlXYScatter
ActiveChart.SetSourceData Source:=Sheets(sht_nm).Range("E15:F19")
Case "6"
Range("E15:F20").Select
Charts.Add
ActiveChart.ChartType = xlXYScatter
ActiveChart.SetSourceData Source:=Sheets(sht_nm).Range("E15:F20")
Case "7"
Range("E15:F21").Select
Charts.Add
ActiveChart.ChartType = xlXYScatter
ActiveChart.SetSou
rceData Source:=Sheets(sht_nm).Range("E15:F21")
Case "8"
Range("E15:F22").Select
Charts.Add
ActiveChart.ChartType = xlXYScatter
ActiveChart.SetSourceData Source:=Sheets(sht_nm).Range("E15:F22")
Case "9"
Range("E15:F23").Select
Charts.Add
ActiveChart.ChartType = xlXYScatter
ActiveChart.SetSourceData Source:=Sheets(sht_nm).Range("E15:F23")
Case "10"
Range("E15:F24").Select
Charts.Add
ActiveChart.ChartType = xlXYScatter
ActiveChart.SetSourceData Source:=Sheets(sht_nm).Range("E15:F24")
Case Else
tmp_msg = MsgBox("你注射的针数超过了10针，请联系作者修改脚本！",vbOKOnly,"警告！")
End Select
ActiveChart.Location Where:=xlLocationAsObject, Name:=sht_nm
ActiveChart.PlotArea.Select
Selection.ClearFormats
ActiveChart.Axes(xlValue).MajorGridlines.Select
Selection.Delete
ActiveChart.SeriesCollection(1).Select
ActiveChart.SeriesCollection(1).Trendlines.Add(Type:=xlLinear, Forward:=0, _
Backward:=0, DisplayEquation:=True, DisplayRSquared:=True).Select
ActiveChart.ChartArea.Select
'
' 假设线性回归方程的形式是：y = a*x + b
' 在输入a, b的值的时候，请务必带上"+/-"号
'
' 生成方程a, b值的输入区域
'
Range("B9").Select
ActiveCell.Value = "a"
Range("D9").Select
ActiveCell.Value = "b"
End Sub
'
' 半自动化计算Inclusion Constant
'
'
Sub Calc_IC
Dim a, b As String
Range("C9").Select
a = ActiveCell.Value
Range("E9").Select
b = ActiveCell.Value
Range("C11").Select
ActiveCell.Value = b / a
End Sub
没有评论:
发表评论