Excel VBA中的缓冲区溢出

Question

我已经完成了我的VBA模块，该模块将根据所提供的医疗服务计算每月记录差异。这工作得很好。然而，当我尝试在第三个月(即3月)运行代码并使用2月份的数据作为静态数据时，我被提醒我的代码已经开始缓冲区溢出。

我检查了我的代码，但我无法确定为什么会出现这种情况-唯一一致的因素是，当我进入第3个月(没有进一步测试)时，4次中有1次我会收到防病毒警报，关闭excel表示溢出。谁能告诉我为什么会这样?

Sub monthlyCalculation()
Dim ws As Worksheet 'Worksheet Variable required for IF statement
Sheets("StaticRecord").Copy After:=Sheets("StaticRecord")
Sheets("StaticRecord (2)").Visible = True
'Rename Summary (3) to Monthly Comparison
Sheets("StaticRecord (2)").Name = "MonthlyComparison"
'Remember to do the subtraction calculations here
Sheets("MonthlyComparison").Select
'Don't use ActiveCell but rather a direct reference to subtract
Range("I6").Value = "=ABS(Summary!I6-'StaticRecord'!I6)"
Range("I6").Select
Selection.AutoFill Destination:=Range("I6:I28"), Type:=xlFillDefault
'Key Metrics Calculation for the created MonthlyComparison Tab
 Range("D6").Value = "= ABS(VALUE(LEFT(Summary!D6,2))-VALUE(LEFT('StaticRecord'!D6,2)))"
 Range("D7").Value = "=ABS((Summary!D7)-('StaticRecord'!D7))"
 Range("D8").Value = "=ABS((Summary!D8)-('StaticRecord'!D8))"
 Range("D9").Value = "= SUM('Template:Template - Book End'!H55)-2"
 Range("D10").Value = "= $D7/$D8"
 Range("D11").Value = "= 1 - D$10"
 Range("D12").Value = "= Summary!D12"
 Range("D13").Value = "= Summary!D13"
 Range("D14").Value = "= Summary!D14"
 Range("D15").Value = "= Summary!D15"
 '# Sessions Calculations
 Range("J6").Value = "=ABS('StaticRecord'!J6-Summary!J6)"
 Range("J6").Select
 Selection.AutoFill Destination:=Range("J6:J27"), Type:=xlFillDefault
 Range("J6:J27").Select
'Now that we have done the calculation we need to get rid of the initial Summary by replacing it with a blank template copy
'However we know that the summary tab CANNOT be cleared unless the user tabs are cleared so we must clear these tabs instead
'We will do this by looping through all user tabs and clearing the set fields'
For Each ws In Worksheets
 If Len(ws.Name) <= 5 Then
    ws.Range("B7:C100").ClearContents
 End If
 Next
'Lastly we need to ensure that if a new comparison is to be completed, it will compare this against the static record which is last
'months statistics. This means that MonthlyComparison will need to be copied across and renamed as a static record with static values.
Application.DisplayAlerts = False
   'StaticRecord has now been deleted so we need to create a new StaticRecord
    Sheets("MonthlyComparison").Copy After:=Sheets("MonthlyComparison")
    Sheets("MonthlyComparison (2)").Visible = True
    Sheets("MonthlyComparison (2)").Name = "StaticRecord (2)"
'Once the monthlyComparison is deleted, the copy of staticRecord (2) will show all REF values
'This will need to be corrected by making the values static
Sheets("MonthlyComparison").Select
 Range("I6:J28").Select
 Selection.Copy
 Sheets("StaticRecord (2)").Select
 Range("I6:J28").Select
 Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
 Sheets("MonthlyComparison").Select
 Range("D6:D15").Select
 Selection.Copy
 Sheets("StaticRecord (2)").Select
 Range("D6:D15").Select
 Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False

For Each ws In Worksheets
  If ws.Name = "StaticRecord" Then
     ws.delete
  End If
Next
'Rename the newly created StaticRecord (2) into StaticRecord
Sheets("StaticRecord (2)").Name = "StaticRecord"
'Now that we have copied the data from MonthlyComparison we can eliminate this tab as it is no longer required
For Each ws In Worksheets
  If ws.Name = "MonthlyComparison" Then
     ws.delete
  End If
Next
End Sub

Answer 1

我修补了一下，我认为我已经发现了导致缓冲区溢出问题的原因。根据我编写函数的方式，由于新创建的表采用了旧的已删除表的名称，因此会有许多表的名称交换。其中一个工作表(monthlycomparations)的计算依赖于另一个工作表——StaticRecord的数据。一旦StaticRecord被删除并随后重新命名，我可能已经引入了一个指针问题，我指向已经清除的内存，这会混淆excel并导致它关闭。此外，我还更改了删除选项卡的顺序。

 For Each ws In Worksheets
  If ws.Name = "MonthlyComparison" Then  
     ws.delete
  End If
Next
For Each ws In Worksheets
  If ws.Name = "StaticRecord" Then
     ws.delete
  End If
Next

最初我先删除了StaticRecord选项卡，然后删除了每月比较。MonthlyRecord依赖于StaticRecord的数据。因此，一旦我首先删除MonthlyRecord，然后删除StaticRecord，问题似乎(至少现在)自行解决。

这是剩下的代码，以防你们中有人能发现我写的任何其他问题:)

Sub monthlyCalculation()
Dim ws As Worksheet
Sheets("StaticRecord").Copy After:=Sheets("StaticRecord")
Sheets("StaticRecord (2)").Visible = True
Sheets("StaticRecord (2)").Name = "MonthlyComparison"
Sheets("MonthlyComparison").Select
Range("I6").Value = "=ABS('StaticRecord'!I6-Summary!I6)"
Range("I6").Select
Selection.AutoFill Destination:=Range("I6:I28"), Type:=xlFillDefault
'Key Metrics Calculation
 Range("D6").Value = "= ABS(VALUE(LEFT('StaticRecord'!D6,2))-VALUE(LEFT(Summary!D6,2)))"
 Range("D7").Value = "=ABS(('StaticRecord'!D7)-(Summary!D7))"
 Range("D8").Value = "=ABS(('StaticRecord'!D8)-(Summary!D8))"
 Range("D9").Value = "= SUM('Template:Template - Book End'!H55)-2"
 Range("D10").Value = "= $D7/$D8"
 Range("D11").Value = "= 1 - D$10"
 Range("D12").Value = "= Summary!D12"
 Range("D13").Value = "= Summary!D13"
 Range("D14").Value = "= Summary!D14"
 Range("D15").Value = "= Summary!D15"
 '# Sessions Calculations
 Range("J6").Value = "=ABS('StaticRecord'!J6-Summary!J6)"
 Range("J6").Select
 Selection.AutoFill Destination:=Range("J6:J27"), Type:=xlFillDefault
 Range("J6:J27").Select

'For future calculations, comparisons between static record and the monthlyComparison tab will be made. This means that
'MonthlyComparison will need to be copied across and renamed as a static record with static values.
Application.DisplayAlerts = False
Sheets("MonthlyComparison").Copy After:=Sheets("MonthlyComparison")
Sheets("MonthlyComparison (2)").Visible = True
Sheets("MonthlyComparison (2)").Name = "StaticRecord (2)"
'Once the monthlyComparison is deleted, the copy of staticRecord (2) will show all REF values. It relies on another
'This will need to be corrected by making the values static so values from MonthlyComparison are copied to Static Record (2)
Sheets("MonthlyComparison").Select
Range("I6:J28").Select
Selection.Copy
Sheets("StaticRecord (2)").Select
Range("I6:J28").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
Sheets("MonthlyComparison").Select
Range("D6:D15").Select
Selection.Copy
Sheets("StaticRecord (2)").Select
Range("D6:D15").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
'Now we delete the existence of MonthlyComparison as it relies on      StaticRecord for calculations
  For Each ws In Worksheets
  If ws.Name = "MonthlyComparison" Then  ''Or ws.Name = "StaticRecord"'
     ws.delete
  End If
Next
For Each ws In Worksheets
  If ws.Name = "StaticRecord" Then
     ws.delete
  End If
Next
End Sub