我在实习中活跃于分析化学领域,希望比较大型数据集(两列,最多15,000行)。这样做的主要思想是,我有两列具有质量数据(带有4个小数点),其中宏应在第二列的第一列中查找每个质量,但存在质量缺陷/错误。这意味着该值并不完全对应(由于测量中的仪器误差),但应落在下限和上限之间。当宏在数据集2中循环以检查每个值时,数据集1的选中单元格将偏移到下一个(.Offset(1,0)),以重复搜索该特定值。上限和下限会自动调整。
举个例子(使用代码格式,否则表将无法正确显示):
Value to check from dataset1 is 101.1048, mass error is 5 ppm (parts-per-million, 0.000005%),
so the lower limit is 101.1043 and the upper limit is 101.1053. So in the example shown below,
the mass in dataset2 falls within the boundaries, after which the macro should sum the intensity
(linked to the mass column) of all mass values from dataset2 that fall within the dataset1 limits
for the checked cell. So SumIntensity=105+209 in the example, if no corresponding value is found,
the intensity of the dataset1 is used (so 100).
**Dataset1** " **Dataset2**
Mass ' Intensity " Mass ' Intensity
''''''''''''''''''''''''''''''''''''''''''''''''''''
101.1048 ' 100 " 101.1045 ' 105
101.1272 ' 300 " 101.1051 ' 209
但是我对VBA经验不足(我只编写了一些基本宏来比较同一数据集中有质量缺陷/错误的值),经过无数次尝试之后,我仍无法使宏正常工作。我当前的代码如下,但一直崩溃(很可能是由于循环):
Sub CompareColumnsTest2()
Dim wscalc, wsdata, wscontrol As Worksheet
Set wscalc = Sheet2
Set wsdata = Sheet1
Set wscontrol = Sheet4
''-----------------------------------------------------------
''Compares datasets 1 and 2 in two steps:
''Looks up each Rounded Mass from dataset1 in dataset2 and substracting the relative intensity respectively
''Looks up each Rounded Mass from dataset 2 in dataset1 and if NOT present in dataset 1, copies Rounded Mass and (negative) Intensity
wscalc.Range("B3:B" & wscalc.Range("B" & Rows.Count).End(xlUp).Row).Copy
wscalc.Range("K3").PasteSpecial (xlPasteValues)
''Step one
Dim refcl, refint, massdefect, lowerlimit, upperlimit As Range
Set refcl = wscalc.Range("B3")
Set refint = wscalc.Range("D3")
Set pastecell = wscalc.Range("L3")
Set massdefect = wscontrol.Range("D4")
Set lowerlimit = wscalc.Range("Z2")
Set upperlimit = wscalc.Range("Z4")
Set checkcl = wscalc.Range("G3")
Set checkint = wscalc.Range("I3")
Dim refclnext, refintnext, checkclnext, pastecellnext As Range, sumint As Long
Do While Not IsEmpty(refcl)
Set refclnext = refcl.Offset(1, 0)
Set refintnext = refint.Offset(1, 0)
Set pastecellnext = pastecell.Offset(1, 0)
Set checkclnext = checkcl.Offset(1, 0)
Set checkintnext = checkint.Offset(1, 0)
sumint = 0
lowerlimit.Value = refcl / (1 + (massdefect / 1000000))
upperlimit.Value = refcl * (1 + (massdefect / 1000000))
Do While Not IsEmpty(checkcl)
If checkcl <= upperlimit And checkcl >= lowerlimit Then
sumint = sumint + checkint
End If
Set checkcl = checkclnext
Set checkint = checkintnext
Loop
Set pastecell.Value = refint - sumint
Set refcl = refclnext
Set refint = refintnext
Set pastecell = pastecellnext
Loop
End Sub
我希望我的描述足够清楚,能够为我提供帮助。我不要求您完全重写我的代码,因为这当然会花费很多时间,但是任何提示/修改将不胜感激。
最好,JamesLooks
编辑1:以下是一些屏幕截图,显示了一些数据以及如何将表格组织为单元格引用。
如Naresh Bhople的评论所建议,我使用了excel函数(IF和SUMIFS)并将它们合并到宏中,这解决了我的问题。
最好,JamesLooks