打开含VBA的其他工作簿时，本VBA单位转换代码运行缓慢求助

这段用于将吨（T）转换为千克（Kg）并调整对应价格的VBA代码，单独运行时（计算模式设为xlManual）流畅，但打开另一个带VBA的工作簿后，运行变得异常缓慢，仿佛计算模式自动变回了xlAutomatic，必须关闭其他工作簿才能恢复流畅。

原代码如下：

Sub mj_Jedinica()
Dim LastRow As Long, i As Long
 
LastRow = Sheet2.Cells(Rows.Count, 1).End(xlUp).Row

  Application.Calculation = xlManual
  
   For i = 2 To LastRow
     Sheet2.Cells(i, 8) = Sheet2.Cells(i, 8) * 1000 'changes T->Kg
     Sheet2.Cells(i, 9) = Sheet2.Cells(i, 9) / 1000 'lowering price
   Next i
    
Application.Calculation = xlAutomatic

   
End Sub

原因分析 #

Application.Calculation的作用范围是整个Excel应用程序，而非单个工作簿。当打开另一个带VBA的工作簿时，该工作簿可能通过代码（比如Workbook_Open事件）强制将计算模式重置为xlAutomatic，导致你的代码在逐单元格修改时，Excel被迫实时计算所有工作簿的公式，拖慢运行速度。

解决方案 #

方案1：保存并恢复原计算模式 #

不要强制将计算模式设为xlAutomatic，而是先保存当前的计算模式，执行完代码后再恢复：

Sub mj_Jedinica()
Dim LastRow As Long, i As Long
Dim originalCalcMode As XlCalculation ' 保存原计算模式

LastRow = Sheet2.Cells(Rows.Count, 1).End(xlUp).Row

' 保存当前计算模式
originalCalcMode = Application.Calculation
Application.Calculation = xlManual
  
For i = 2 To LastRow
  Sheet2.Cells(i, 8) = Sheet2.Cells(i, 8) * 1000 ' 吨转千克
  Sheet2.Cells(i, 9) = Sheet2.Cells(i, 9) / 1000 ' 调整价格
Next i
  
' 恢复原计算模式
Application.Calculation = originalCalcMode
End Sub

方案2：禁用事件触发避免干扰 #

其他工作簿的事件（如Workbook_Open、SheetChange）可能会修改计算模式，因此在代码执行期间禁用事件，结束后恢复：

Sub mj_Jedinica()
Dim LastRow As Long, i As Long
Dim originalCalcMode As XlCalculation
Dim originalEvents As Boolean ' 保存原事件状态

LastRow = Sheet2.Cells(Rows.Count, 1).End(xlUp).Row

' 保存当前状态
originalCalcMode = Application.Calculation
originalEvents = Application.EnableEvents
  
Application.Calculation = xlManual
Application.EnableEvents = False
  
For i = 2 To LastRow
  Sheet2.Cells(i, 8) = Sheet2.Cells(i, 8) * 1000 ' 吨转千克
  Sheet2.Cells(i, 9) = Sheet2.Cells(i, 9) / 1000 ' 调整价格
Next i
  
' 恢复原状态
Application.Calculation = originalCalcMode
Application.EnableEvents = originalEvents
End Sub

方案3：数组批量操作（最优解） #

将单元格数据读入数组，修改后一次性写回，彻底减少Excel的界面交互，即使计算模式为自动也能高效运行：

Sub mj_Jedinica()
Dim LastRow As Long
Dim ws As Worksheet
Dim dataRange As Range
Dim dataArr As Variant
Dim i As Long

Set ws = Sheet2
LastRow = ws.Cells(Rows.Count, 1).End(xlUp).Row
Set dataRange = ws.Range(ws.Cells(2, 8), ws.Cells(LastRow, 9))
dataArr = dataRange.Value ' 读入数组

' 修改数组内容
For i = LBound(dataArr, 1) To UBound(dataArr, 1)
  dataArr(i, 1) = dataArr(i, 1) * 1000 ' 吨转千克
  dataArr(i, 2) = dataArr(i, 2) / 1000 ' 调整价格
Next i

' 一次性写回单元格
dataRange.Value = dataArr
End Sub

内容的提问来源于stack exchange，提问作者Jelovac Maglaj