得到錯誤沒有1004，同時運行VBA代碼

Question

我跑在Excel 2007中的VBA代碼，我得到了1004

我的代碼上面提到的運行/應用程序錯誤是

Public Sub LblImport_Click() 
Dim i As Long, j As Long 
Dim vData As Variant, vCleanData As Variant, vFile As Variant, sMarket As String 
Dim wbkExtract As Workbook, sLastCellAddress As String, month As String 
Dim cnCountries As New Collection 

Application.ScreenUpdating = False 

' Get the name of the Dataview Extract file to transform and the market name 

vFile = "D:\DRX\" & "Norvasc_Formatted.xlsx" 

sMarket = "Hypertension" 

ThisWorkbook.Worksheets("Control").Range("TherapeuticMarket").Value = "Hypertension" 

' Clear all existing data from this workbook 

ThisWorkbook.Worksheets("RawData").Cells.ClearContents 


' Create labels in Raw Data Sheet 

ThisWorkbook.Worksheets("RawData").Cells(1, 1).Value = "Therapy Market" 
ThisWorkbook.Worksheets("RawData").Cells(1, 2).Value = "Country" 
ThisWorkbook.Worksheets("RawData").Cells(1, 3).Value = "Brand" 
ThisWorkbook.Worksheets("RawData").Cells(1, 4).Value = "Corporation" 
ThisWorkbook.Worksheets("RawData").Cells(1, 5).Value = "Molecule" 

' Open Dataview extract, copy and clean data 

Set wbkExtract = Workbooks.Open(vFile) 
i = 2 
Do While wbkExtract.ActiveSheet.Cells(1, i).Value <> "" 

    If UCase(Mid(wbkExtract.ActiveSheet.Cells(1, i).Value, 1, 3)) = "TRX" Then 
     month = Split(wbkExtract.ActiveSheet.Cells(1, i).Value, "/")(1) 
     If Len(month) = 1 Then 
      month = "0" + month 
     End If 
     ThisWorkbook.Worksheets("RawData").Cells(1, i + 4).Value = Mid(wbkExtract.ActiveSheet.Cells(1,  i).Value, 1, 10) + month + "/" + Mid(Split(wbkExtract.ActiveSheet.Cells(1, i).Value, "/")(2), 3, 2) 
    End If 
    If UCase(Mid(wbkExtract.ActiveSheet.Cells(1, i).Value, 1, 3)) = "LCD" Then 
     month = Split(wbkExtract.ActiveSheet.Cells(1, i).Value, "/")(2) 
     If Len(month) = 1 Then 
      month = "0" + month 
     End If 
     ThisWorkbook.Worksheets("RawData").Cells(1, i + 4).Value = Mid(wbkExtract.ActiveSheet.Cells(1, i).Value, 1, 14) + month + "/" + Mid(Split(wbkExtract.ActiveSheet.Cells(1, i).Value, "/")(3), 3, 2) 
    End If 
    i = i + 1 
Loop 
wbkExtract.ActiveSheet.Cells(1, 1).EntireRow.Delete 
vData = wbkExtract.ActiveSheet.Cells(1, 1).CurrentRegion.Value 
wbkExtract.Close savechanges:=False 
vCleanData = CleanRawData(vData, sMarket) 
sLastCellAddress = ThisWorkbook.Worksheets("RawData").Cells(UBound(vCleanData, 1) + 1, UBound(vCleanData, 2)).Address(RowAbsolute:=False, ColumnAbsolute:=False) 
ThisWorkbook.Worksheets("RawData").Range("A2:" & sLastCellAddress).Value = vCleanData 

' Get List of Unique Countries 

On Error Resume Next 

For i = 1 To UBound(vCleanData, 1) 
    cnCountries.Add vCleanData(i, 2), vCleanData(i, 2) 
Next i 

On Error GoTo 0 

ThisWorkbook.Worksheets("Market").Cells(1, 1).CurrentRegion.Clear 
ThisWorkbook.Worksheets("Market").Cells(1, 1).Value = "Country" 
ThisWorkbook.Worksheets("Market").Cells(1, 2).Value = "Group 1" 
ThisWorkbook.Worksheets("Market").Cells(1, 3).Value = "Group 2" 
ThisWorkbook.Worksheets("Market").Cells(1, 4).Value = "Group 3" 
ThisWorkbook.Worksheets("Market").Cells(1, 5).Value = "Group 4" 
ThisWorkbook.Worksheets("Market").Range("A1:G1").Font.Bold = True 

For i = 1 To cnCountries.Count 
    ThisWorkbook.Worksheets("Market").Cells(i + 1, 1).Value = cnCountries.Item(i) 
Next i 


End Sub 

Answer 1

聽起來像一個破碎的代碼緩存。

我以前在舊格式（xls）工作簿中發現過像這樣的錯誤，它可能是整個文件中存在問題的跡象。

先嚐試@Scott Holtzman建議的編譯選項。在某些情況下，我看到重新編譯不起作用，如果發生這種情況，只需對代碼進行更改即可強制編譯。一個微不足道的變化通常是足夠的。

如果這樣做不起作用（爲了幫助解決腐敗問題），請嘗試將代碼複製到新的工作簿中，並查看發生了什麼。如果它運行在新的工作表上，那麼我不會浪費更多時間在它上面，只是重建工作表，相信我會更快地解決你遇到的問題。