Excel VBA 中的缓冲区溢出

Buffer Overflow in Excel VBA

我已经完成了我的 VBA 模块,该模块将根据提供的医疗服务计算月度记录差异。这运作良好。但是,当我尝试 运行 第 3 个月(即 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"
 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

我进行了修改,认为我发现了导致我的缓冲区溢出问题的原因。根据我对函数的编码方式,有很多 sheet 的名称交换,因为新创建的 sheet 会使用旧的已删除 sheet 的名称。其中一项工作 -sheet 特别是 (MonthlyComparisons) 的计算依赖于另一项工作 -sheet - 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"
 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