当我运行这个 vba sub 时，Excel 停止并崩溃

Question

我不熟悉用 excel 编写和一般编码。我写这个是为了检查相应的单元格是否为空，如果不是，则循环遍历数组。如果单元格中存在任何数组，则目标单元格值将为“Y”。

它通过一排然后停止。我将问题隔离为 for 循环，但我无法弄清楚是什么导致它崩溃 Excel。任何帮助是极大的赞赏。

Sub test()
    Dim LR As Long, i As Long, j As Long, aNames
    aNames = Array("this", "that", "the other")
    
    Cells(2, 21).Activate

    Do While Not IsEmpty(ActiveCell.Offset(, -15))
        For j = LBound(aNames) To UBound(aNames)
            On Error Resume Next
            If ActiveCell.Offset(, -15).Value Like "*" & aNames(j) & "*" Then
                ActiveCell.Value = "Y"
                ActiveCell.Offset(1, 0).Activate
                On Error GoTo Last
            Else
            End If
        Next j
    Loop
Last:
End Sub

Answer 1

当最后的“End Sub”运行时，我的代码崩溃了。我尝试了所有我能想到的方法，包括创建一个新的 Excel 工作簿并将代码复制到该工作簿中。我也检查了这个网站，但我找不到符合我的情况。有什么想法吗？代码在“Main”子程序结束时崩溃。

Option Explicit

Dim wsData As Worksheet

Sub Main()

    Dim arrTrading() As Variant
    
    Dim arrCenter() As Variant
    
    Dim arrCategory() As Variant
    
    Dim arrCountry() As Variant
    
    Dim lastRow As Integer
    
     TurnOffFunctionality

    Set wsData = Sheets("State Package Data")
    
    lastRow = getLastRowByEndUp(wsData, 1)
    
    wsData.Range("M2:M" & lastRow).Clear
    
    wsData.Range("n2:n" & lastRow).Clear
    
    wsData.Range("o2:o" & lastRow).Clear
    
    ReadDataFromCloseFile arrTrading, arrCenter, arrCategory, arrCountry
    
    lookup arrCountry, lastRow, "j", 20, "n", 8, "country"
    
    lookup arrCategory, lastRow, "f", 1, "m", 3, "category"
    
    lookup arrTrading, lastRow, "j", 1, "o", 3, "trading partner"
         
    TurnOnFunctionality

End Sub

Sub lookup(arr As Variant, lastRow As Integer, lookupCol As String, matchCol As Integer, postCol As String, returnCol As Integer, name As String)

    Dim i As Integer
    
    Dim x As Integer
    
    Dim lookupValue As String
    
    Dim matchValue As String

        
    For i = 2 To lastRow
    
        lookupValue = wsData.Cells(i, lookupCol)
        
        For x = 2 To UBound(arr)
        
            matchValue = arr(x, matchCol)
        
            If lookupValue = matchValue Then
                               
                wsData.Cells(i, postCol) = arr(x, returnCol)
                
                Exit For
            
            End If
        
        Next x
    
    Next i

    Debug.Print name
    
End Sub

Sub createArrays(arrTrading As Variant, arrCenter As Variant, arrCategory As Variant, arrCountry As Variant)

    Sheets("Mapping").Activate
    
    arrCategory = Range("g1").CurrentRegion
    
    
    arrCenter = Range("k1").CurrentRegion
    
    
    arrTrading = Range("n1").CurrentRegion
    
    
    Sheets("BPC Consol Ownership").Activate
    
    arrCountry = Range("a1").CurrentRegion

End Sub

Sub ReadDataFromCloseFile(arrTrading As Variant, arrCenter As Variant, arrCategory As Variant, arrCountry As Variant)

    On Error GoTo ErrHandler
    
    Application.ScreenUpdating = False
    
    Dim src As Workbook
  
    Set src = Workbooks.Open("C:UsersredrDownloads	axpackageMapping.xlsx", True, True)
    
    createArrays arrTrading, arrCenter, arrCategory, arrCountry
    
    src.Close False
    
    Set src = Nothing
    
ErrHandler:
    Application.EnableEvents = True
    
    Application.ScreenUpdating = True
End Sub

Public Sub TurnOffFunctionality()

    Application.Calculation = xlCalculationManual
    
    Application.DisplayStatusBar = False
    
    Application.EnableEvents = False
    
    Application.ScreenUpdating = False
    
End Sub

Public Sub TurnOnFunctionality()

    Application.Calculation = xlCalculationAutomatic
    
    Application.DisplayStatusBar = True
    
    Application.EnableEvents = True
    
    Application.ScreenUpdating = True
    
End Sub

Function getLastRowByEndUp(ws As Worksheet, col As Integer)

    Dim lastRow As Integer
    
    lastRow = ws.Cells(Rows.Count, col).End(xlUp).Row
    
    getLastRowByEndUp = lastRow
    
End Function