Как исправить «недостаток памяти» eroor

Question

Мой следующий код poppes runtime error7: «вне памяти». Я не понимаю, почему это не очень длинный код. Я определил строку, в которой произошла ошибка. Любые мысли

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 

Благодаря

Answer 1

у вас есть дополнительный "s" во второй части вашего если заявление

Изменить это:?!.

(Cells.Value) = "Archived" 

:

(cell.Value) = "Archived"