关闭第二个工作簿时 Excel 丢失数据

Question

在问题底部编辑

我的代码中有一个函数，它获取样本字典，从另一个工作簿填充数据并返回填充的字典。一切正常，但是一旦我将文件的打开方式更改为只读，我就会遇到问题。

这里是代码（已被简化以删除多余的部分）：

Function get_samples_data(ByVal instructions As Scripting.Dictionary, ByRef patients_data As Scripting.Dictionary) As Scripting.Dictionary
    'takes a dictionary of samples and fills their data from the file <0 GL all RL>
    Dim wb          As Workbook
    Dim ws          As Worksheet
    Dim data_start  As Long
    Dim data_end    As Long
    Dim rw          As Range
    Dim rw_nr       As String
    
    'open <GP all> in ReadOnly mode based on path and filename in specific cells
    Application.ScreenUpdating = False
    Set wb = Workbooks.Open(ThisWorkbook.Sheets(1).Cells(13, 2).Value2 & ThisWorkbook.Sheets(1).Cells(13, 1).Value2, False, True)
    Set ws = wb.Worksheets("ALL")
    
    'get row nr. of the first and the last sample to export
    data_start = ws.Columns("A:A").Find(what:=instructions("from_sample"), LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByRows).Row
    data_end = ws.Columns("A:A").Find(what:=instructions("to_sample"), LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByRows).Row
        
    'main loop
    For i = data_start To data_end
        Set rw = ws.Rows(i)
        rw_nr = rw.Cells(1, 1).Value
        If rw.Cells(1, 11).Value = instructions("group") Then
            If patients_data.Exists(rw_nr) Then
                Set patients_data(rw_nr) = fetch_sample_data(rw, patients_data(rw_nr))
            End If
        End If
    Next

    'close <GP all> without saving
    wb.Close (False)

    Set get_samples_data = patients_data
End Function

当我调试时，我注意到数据在调用 wb.Close(False) 时丢失了。直到该点数据完好无损，但一旦关闭源工作簿，数据（它是一个范围对象）就会变为空白。未设置为空，当在源工作簿中找不到数据时会发生这种情况，但在调试器中可以看到范围对象的所有属性，但所有属性的值都是 .

在我将 openmode 更改为 ReadOnly 之前，一切正常，数据保留在那里。 我错过了什么？为什么存储在不同变量中的数据会丢失？

编辑： 获取样本数据确实返回一个范围对象。

Private Function fetch_sample_data(ByVal rw As Range, ByRef sm As sample) As sample
    Dim data As Range
    
    Set data = Range(rw.Cells(1, 19), rw.Cells(1, 63))
    Set sm.data = data
    Set fetch_sample_data = sm
    
End Function

我尝试改变关闭顺序并设置返回值，但还是报错。

那么，Range 对象是否始终只是对工作表中某个范围的引用？如果我希望数据保留，是否需要将所有有问题的 Range 对象更改为数组？或者有没有办法创建一个独立于工作簿的 Range 对象（我不想将范围复制到带有宏的主工作簿中的任何工作表中）？

下面是主子，正如@Pᴇʜ 要求的那样。剩下的函数我就不加了，因为整个代码分散在 1 个表单、2 个模块和 14 个类上（很多都带有很长的方法）。 两个注释的打开命令是那些导致一切正常工作的命令。关闭命令位于 main sub 的末尾，因此关于@Pᴇʜ 的注释，如果 range 对象始终只是对实际单元格范围的引用，则它们在整个程序期间都可用。

Sub RL_creator_GP_main()
    Dim instructions    As New Scripting.Dictionary
    Dim samples         As Scripting.Dictionary
    Dim result_list     As Variant
    Dim rep             As cReport
    Dim scribe          As New descriptor
    
    Application.ScreenUpdating = False
    
    'get instructions from inputboxes (group, from sample, to sample)
    Set instructions = procedures.input_instructions()
    If instructions.Exists("terminated") Then
        Exit Sub
    End If
    
    'get <GP all> and <RL headers> ready
    'Call procedures.prepare_file("GP all.xlsx", pth:=ThisWorkbook.Sheets(1).Cells(12, 2).Value)
    'Call procedures.prepare_file("RL headers.xlsx", pth:=ThisWorkbook.Sheets(1).Cells(13, 2).Value)
    
    'get patients data from <RL headers>, closes the file afterwards
    Set samples = procedures.get_patients_data(instructions)
    
    'get patients data from <GP all>, closes the file afterwards
    Set samples = procedures.get_samples_data(instructions, samples)

Answer 1

因为samples已提交ByRef到get_samples_data你不需要返回：

Sub RL_creator_GP_main()
    'your code here …

    'get patients data from <RL headers>, closes the file afterwards
    Set samples = procedures.get_patients_data(instructions)
    
    'get patients data from <GP all>, closes the file afterwards
    procedures.get_samples_data instructions, samples 'this call will change the original samples because it is ByRef!

在fetch_sample_data 中，您将一个范围添加到您的字典中。但是Range 对象只是对工作表的引用，并不包含数据本身。因此，与其将范围转换为数组以添加实际数据，而不仅仅是引用：

Private Sub fetch_sample_data(ByVal rw As Range, ByRef sm As sample)
    Dim data() As Variant
    data = Range(rw.Cells(1, 19), rw.Cells(1, 63)).Value
    Set sm.data = data
    'again you don't need a function to return the sample as it is ByRef 
End Sub

最后get_samples_data 应该是一个子而不是一个函数。并调用fetch_sample_data 作为子fetch_sample_data rw, patients_data(rw_nr)

Sub get_samples_data(ByVal instructions As Scripting.Dictionary, ByRef patients_data As Scripting.Dictionary)
    'takes a dictionary of samples and fills their data from the file <0 GL all RL>
    Dim wb          As Workbook
    Dim ws          As Worksheet
    Dim data_start  As Long
    Dim data_end    As Long
    Dim rw          As Range
    Dim rw_nr       As String
    
    'open <GP all> in ReadOnly mode based on path and filename in specific cells
    Application.ScreenUpdating = False
    Set wb = Workbooks.Open(ThisWorkbook.Sheets(1).Cells(13, 2).Value2 & ThisWorkbook.Sheets(1).Cells(13, 1).Value2, False, True)
    Set ws = wb.Worksheets("ALL")
    
    'get row nr. of the first and the last sample to export
    data_start = ws.Columns("A:A").Find(what:=instructions("from_sample"), LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByRows).Row
    data_end = ws.Columns("A:A").Find(what:=instructions("to_sample"), LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByRows).Row
        
    'main loop
    For i = data_start To data_end
        Set rw = ws.Rows(i)
        rw_nr = rw.Cells(1, 1).Value
        If rw.Cells(1, 11).Value = instructions("group") Then
            If patients_data.Exists(rw_nr) Then
                fetch_sample_data rw, patients_data(rw_nr)
            End If
        End If
    Next

    'close <GP all> without saving
    wb.Close (False)
End Sub

---

背景说明

调用函数和子函数：
首先，不需要Call 语句。函数中的参数总是用括号括起来的，函数是用来返回值的。

Result = MyFunction(Param1, Param2) ' functions return a result and parameters are in parentesis

MySub Param1, Param2 ' subs don't return a result and don't use parentesis

Call MySub(Param1, Param2) ' But with the Call statement they need parentesis

ByRef 做了什么：
如果您声明一个参数ByRef，这意味着您不向子提交数据，而只是对内存中该数据的引用（通过引用）。所以如果你有以下子：

Sub MySub(ByVal Param1, ByRef Param2)
    Param1 = 1
    Param2 = 2
End Sub

并像使用它

Sub Example()
    Dim Var1 As Long: Var1 = 10
    Dim Var2 As Long: Var2 = 20

    MySub Var1, Var2 'note Var2 is submitted ByRef!

    Debug.Print Var1, Var2 'returns 10,  2 the value in Var2 got changed by MySub without returning anything
End Sub

因此，当您通过引用提交变量时，这意味着MySub 在执行Param2 = 2 时会更改Var2 中的值，因为Param2 和Var2 引用内存中的相同空间。而如果您提交ByVal（按值），您实际上会在内存中复制数据，Param1 和Var1 引用内存中的不同位置。

这就是为什么你不需要一个函数来返回一些东西如果你提交它ByRef你已经改变了内存中的数据。

所以在你的代码中，如果你声明Sub get_samples_data(ByVal instructions As Scripting.Dictionary, ByRef patients_data As Scripting.Dictionary)，那么像procedures.get_samples_data instructions, samples 这样调用它会使patients_data 和samples 指向内存中的相同空间。因此，因为数据在内存中只有一次，并且只有 2 个链接指向它们，所以在其中一个链接中所做的任何更改实际上都会编辑内存中完全相同的数据。因此不需要返回数据。