在VBA中使用Scripting.Dictionary迭代器会返回错误的答案

时间:2017-10-13 02:13:45

标签: excel vba excel-vba dictionary

我正在研究一些代码,这些代码需要比较在不同日期进行的测量,其中测量的位置往往会在运行之间漂移。我通过查看测量的一个特定变量来对齐它,在-100米到+100米的范围内抵消它,并查看后续读数之间的变化率(它们相距半米) ,平衡差异并查看什么值偏移最小化平方和。

所以我有三种方法可以做到这一点。我可以在Excel中转​​储值,并使用偏移公式。对于下面带代码的示例,最小化误差是当偏移量为259个读数时(29.5米为正,给定200为-100米到无偏移量,每个读数为0.5米,因此59 * 0.5为29.5米) )。错误总和的值是2618.24690000001 - 这并不意味着什么,它只是现阶段的参考。

选项2是通过.GetRows方法将记录集结果传递给数组,并在不使用Excel工作表和范围对象的情况下计算差异。我得到了相同的答案 - 偏差为259个读数,对于完全相同的误差总和,直到第15个sig数字。

选项3是将两个记录集结果放在scripting.dictionary实例中,并使用它们计算错误。在那里,我获得了59个读数的偏移量,但误差数字的总和完全相同,再次为15个sig数字。我已经测试了几个不同的位置,它似乎总是超过200个读数。

我已经介入了代码,我搜索了这个网站,我甚至看到了非StackOverflow网站的任何谷歌搜索结果(哎呀!),我完全失去了。我确信这是非常简单的(而且很可能是非常愚蠢的)我已经完成了,当它指出时我会感到很尴尬,但我不能为我的生活做出努力。

数组代码:

Private Sub array_manipulation(track_section As c_track_section)

Dim ss_variance As Double, offset_variance As Double
Dim ss_offset As Integer, i As Integer
Dim record_count As Long
Dim ref_array As Variant, run_array As Variant

record_count = Application.WorksheetFunction.Min(track_section.rs.RecordCount, track_section.align_rs.RecordCount - 400) - 1
ref_array = track_section.rs.GetRows(-1, 0)
run_array = track_section.align_rs.GetRows(-1, 0)
ss_variance = return_squared_errors(ref_array, run_array, 0, record_count)
ss_offset = 0
For i = 1 To 400
    offset_variance = return_squared_errors(ref_array, run_array, i, record_count)
    If offset_variance < ss_variance Then
        ss_variance = offset_variance
        ss_offset = i
    End If
Next i

MsgBox "ss_error is " & ss_variance & " at an offset of " & ss_offset & " intervals", vbOKOnly, "Did it work?"

End Sub

return_squared_errors函数:

Private Function return_squared_errors(ref_array As Variant, run_array As Variant, offset As Integer, record_count As Long)

Dim i As Long
Dim ss_variance As Double


ss_variance = 0

For i = 1 To record_count
    ss_variance = ss_variance + ((ref_array(1, i) - ref_array(1, i - 1)) - _
                                (run_array(1, i + offset) - run_array(1, i + offset - 1))) ^ 2
Next i

return_squared_errors = ss_variance

End Function

字典代码:

Private Sub dict_manipulation(track_section As c_track_section)

Dim ss_variance As Double, offset_variance As Double
Dim ref_dict As Object, run_dict As Object
Dim ss_offset As Integer, i As Integer

Set ref_dict = CreateObject("Scripting.Dictionary")
Set run_dict = CreateObject("Scripting.Dictionary")
Call populate_dictionary(track_section.rs, ref_dict)
Call populate_dictionary(track_section.align_rs, run_dict)

ss_variance = return_dict_ss(ref_dict, run_dict, 0)
ss_offset = 0
For i = 1 To 400
    offset_variance = return_dict_ss(ref_dict, run_dict, i)
    If offset_variance < ss_variance Then
        ss_variance = offset_variance
        ss_offset = i
    End If
Next i

MsgBox "ss_error is " & ss_variance & " at an offset of " & ss_offset & " intervals", vbOKOnly, "Did it work?"

End Sub

return_dict_ss函数:

Private Function return_dict_ss(ref_dict As Object, run_dict As Object, offset As Integer) As Double

Dim key As Variant
Dim ss_variance As Double, reading_interval As Double, offset_distance As Double
Dim current_key As String

reading_interval = 0.0005
offset_distance = offset * reading_interval
ss_variance = 0
For Each key In ref_dict.keys
    If ref_dict.exists(CStr(CDbl(key) - reading_interval)) And _
        run_dict.exists(CStr(CDbl(key) + offset_distance)) And _
        run_dict.exists(CStr(CDbl(key) - reading_interval + offset_distance)) Then
            ss_variance = ss_variance + ((ref_dict(key) - ref_dict(CStr(CDbl(key) - reading_interval))) - _
                (run_dict(CStr(CDbl(key) + offset_distance)) - run_dict(CStr(CDbl(key) - reading_interval + offset_distance)))) ^ 2
    End If
Next key

return_dict_ss = ss_variance

End Function

编辑:我可能应该注意c_track_section对象的track_section是用户定义的类。它没有函数或方法,它只包含很多setter / getter对,以避免在调用subs或函数时传递大量参数。

0 个答案:

没有答案