我的以下代码弹出运行时错误7：“内存不足”。我不明白为什么。它不是一个很长的代码。我确定了发生错误的行。有什么想法吗？
Sub discrepancy_report()
Dim var1 As Long
Dim var2 As Long
Dim var3 As Long
Dim colrg As Range
Dim lastr As Long
Dim dr As String
Dim r As Integer
Dim sht1 As Worksheet
Dim sht2 As Worksheet
Dim errbox As Integer
r = 5
On Error GoTo DataSheetError
Set sht1 = Sheets("DataSheet")
On Error GoTo DiscrepancySheetError
Set sht2 = Sheets("DiscrepancyReport")
On Error GoTo 0
sht2.Select
Rows("9:999").Select
Selection.Delete Shift:=xlUp
Range("A9").Select
sht1.Select
lastr = ActiveSheet.Range("A1").Offset(ActiveSheet.Rows.Count - 1, 0).End(xlUp).Row
lastr = lastr - 1
'Store Values in Array
Dim tbl As Range
Dim var() As Variant
Dim c As Long, matchRow As Long
Set tbl = Range("A3:G" & lastr)
ReDim var(1 To tbl.Rows.Count)
For c = 1 To tbl.Rows.Count
var(r) = tbl(r, 1) & tbl(r, 2) & tbl(r, 3) & tbl(r, 4) & tbl(r, 5)
Next
'Column 1: WP
Set colrg = Range("A3:A" & lastr)
For Each cell In colrg
If (cell.Value) = 6.01 Or (cell.Value) = 6.03 Or (cell.Value) = 6.04 Or (cell.Value) = 6.27 Then
Else
sht2.Cells(r, 1).Value = cell.Address
sht2.Cells(r, 2).Value = (cell.Value)
sht2.Cells(r, 3).Value = "Not a valid WP"
r = r + 1
End If
Next
Set colrg = Range("B3:B" & lastr)
For Each cell In colrg
If (cell.Value) < 99999 And (cell.Value) > 10000 Then
Else
sht2.Cells(r, 1).Value = cell.Address
sht2.Cells(r, 2).Value = (cell.Value)
sht2.Cells(r, 3).Value = "This is not a valid PCR number"
r = r + 1
End If
Next
Set colrg = Range("C3:C" & lastr)
For Each cell In colrg
If (cell.Value) = "Stage 0 - Submit PCR" _
Or (cell.Value) = "Stage 1a - Director Approval" _
Or (cell.Value) = "Stage 1b - PMO Approval" _
Or (cell.Value) = "Stage 1c - CB1 Approval" _
Or (cell.Value) = "Stage 2a - TIM and Request Impacts" _
Or (cell.Value) = "Stage 2b - Track Impacts" _
Or (cell.Value) = "Stage 2c - Consolidation" _
Or (cell.Value) = "Stage 3a - Post CB2 Action Closing" _
Or (cell.Value) = "Stage 3b - CSLT Approval" _
Or (cell.Value) = "Stage 3c - Finance Approval" _
Or (cell.Value) = "Stage 4a - Request PIP" _
Or (cell.Value) = "Stage 4b - Track PIP" _
Or (cell.Value) = "Stage 5a - Track PCRIN" _
Or (cell.Value) = "Stage 5b - Implementation Consolidation" _
Or (cell.Value) = "Stage 6 - Closed" Then
Else
sht2.Cells(r, 1).Value = cell.Address
sht2.Cells(r, 2).Value = (cell.Value)
sht2.Cells(r, 3).Value = "This is not an official ICMS stage. ex: 'Stage 5b - Implementation Consolidation'"
r = r + 1
End If
Next
Set colrg = Range("D3:D" & lastr)
c = 1
For Each cell In colrg
'## out of memory error on the following line
If (cell.Value) = "Kiled" Or (Cells.Value) = "Archived" Then
c = c + 1
ElseIf tbl.Cells(c, 3).Value = "Stage 1a - Director Approval" _
Or tbl.Cells(c, 3).Value = "Stage 1b - PMO Approval" _
Or tbl.Cells(c, 3).Value = "Stage 1c - CB1 Approval" _
Or tbl.Cells(c, 3).Value = "Stage 2a - TIM and Request Impacts" _
Or tbl.Cells(c, 3).Value = "Stage 2b - Track Impacts" _
Or tbl.Cells(c, 3).Value = "Stage 2c - Consolidation" _
Or tbl.Cells(c, 3).Value = "Stage 3a - Post CB2 Action Closing" _
Or tbl.Cells(c, 3).Value = "Stage 3b - CSLT Approval" _
Or tbl.Cells(c, 3).Value = "Stage 3c - Finance Approval" Then
cell.Value = "Pre-Approval"
c = c + 1
ElseIf tbl.Cells(c, 3).Value = "Stage 4a - Request PIP" _
Or tbl.Cells(c, 3).Value = "Stage 4b - Track PIP" _
Or tbl.Cells(c, 3).Value = "Stage 5a - Track PCRIN" _
Or tbl.Cells(c, 3).Value = "Stage 5b - Implementation Consolidation" _
Or tbl.Cells(c, 3).Value = "Stage 6 - Closed" Then
cell.Value = "Approved"
c = c + 1
Else
sht2.Cells(r, 1).Value = cell.Address
sht2.Cells(r, 2).Value = (cell.Value)
sht2.Cells(r, 3).Value = "This PCRs Stage is not correct so the Status cannot be determined"
r = r + 1
c = c + 1
End If
Next
Exit Sub
DataSheetError:
errbox = MsgBox("There is an error witht the main data tab. Either it has been" & Chr(13) & "deletod or renamed." & Chr(13) & Chr(13) & "Please ensure the main tab is present and named 'DataSheet'", vbOKOnly, "Data Tab Error")
Exit Sub
DiscrepancySheetError:
ThisWorkbook.Sheets.Add After:=Sheets(Worksheets.Count), Count:=1, Type:=xlWorksheet
ActiveSheet.Name = "DiscrepancyReport"
Resume Next
End Sub
谢谢！