当第二个工作簿打开时，VBA脚本的运行时间会延长1000倍（尚未使用）

所有 –

我正在编写一个脚本来帮助我处理一些数据。 我正在testing下面的代码，名为“smallWorkbook”，它只有几千行数据。 我从 SmallWorkbook 上运行smallWorkbook 中的数据的代码。 代码运行在0.06秒（select范围之后）。

我还有一个50 MB的工作簿，其中有30个工作表，名为“largeWorkbook”。 如果我只是将smallWorkbook与SmallWorkbook同时打开，并按上述方式运行代码，则代码需要60秒才能运行！

有人可以描述为什么在 smallWorkbook中运行SmallWorkbook中的数据的代码而 largeWorkBook处于打开状态时，运行时间会如此之慢？ 这与我的代码写入方式或我的范围是否合格有关吗？ 我对这些微妙的事情不太好。

谢谢阅读。

这里是代码：

Option Explicit '************************************************* '************************************************* Sub MinInGroup() 'MIN IN GROUP 'Use this sub to add a table that contains unique IDs as rows 'and min quantities for each group that corresponds to unique ID 'Table is added to worksheet named sandbox" hard-coded in this routine 'Future work: '1)add ability to selct from another workbook to create 'standalone app (selecting a range in another wrkbk requires custom user form, spaces in wrkbk or sheet 'names makes trouble). '2) dont hard code headers '3) array sizing - 1000 OK for this use case '4) Remove lines that get minimum of columnn next to one choosen as this is not nominal case 'EXAMPLE: 'calling MinInGroup on range GRP range and QTY range: ' GRP|QTY ' AA | 5 ' AA | 9 ' AA | 2 ' BB | 1 ' BB | 5 ' CC | 26 ' CC | 70 ' Returns ' GRP|MIN ' AA | 2 ' BB | 1 ' CC | 26 Dim grpNameRng As Range 'range containing sub groups (ie AA,BB,CC) Dim valRng As Range 'range containing values to find min on Set grpNameRng = Application.InputBox("Select group range (no headers)", "Select Group Range", Type:=8) Set valRng = Application.InputBox("Select value range (no headers)", "Select Value Range", Type:=8) '*************************************** 'For dev only, delete when done Dim StartTime As Double Dim SecondsElapsed As Double StartTime = Timer '*************************************** 'Make sure same length If grpNameRng.Count <> valRng.Count Then MsgBox ("Ranges must have same number of elements. Exiting.") Exit Sub End If Dim i As Long, j As Long Dim grpStartIndex As Long 'row index of start of new group Dim grpNameArry(1000) As Variant 'Array of unique grps. In EX above grpNameArry = {AA, BB, CC} Dim minValArry(1000) As Variant 'Array of min vals each group. minValArry = {2, 1, 26} 'Turn off screen updates Application.ScreenUpdating = False j = 1 grpStartIndex = 1 grpNameArry(j) = grpNameRng(1) For i = 1 To grpNameRng.Count If (grpNameRng(i)) <> grpNameRng(i + 1) Then 'i is end of current group 'calc MIN val for current group minValArry(j) = Application.WorksheetFunction.Min(Range(valRng.Cells(grpStartIndex), valRng.Cells(i))) grpStartIndex = i + 1 j = j + 1 grpNameArry(j) = grpNameRng(i + 1) End If Next i 'Write results to a range in "sandbox" sheet With Worksheets("sandbox") 'Write headers .Range("D3").Value = "LC" .Range("D3").Font.Bold = True .Range("E3").Value = "Min Msy" .Range("E3").Font.Bold = True .Range("F3").Value = "Min Msu" .Range("F3").Font.Bold = True For i = 1 To j - 1 .Range(.Cells(3 + i, 5), .Cells(3 + i, 5)).Value = minValArry(i) .Range(.Cells(3 + i, 4), .Cells(3 + i, 4)).Value = grpNameArry(i) Next i End With 'Turn off screen updates Application.ScreenUpdating = True '*************************************** 'For dev only, delete when done 'Determine how many seconds code took to run SecondsElapsed = Round(Timer - StartTime, 2) MsgBox ("Code ran in " & SecondsElapsed & " seconds.") '*************************************** End Sub