運行 VBA 代碼時出現錯誤號 1004

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 建議的編譯選項。 在某些情況下，我看到重新編譯不起作用，如果發生這種情況，只需通過更改代碼來強制編譯。 通常一個微不足道的改變就足夠了。

如果這不起作用，那么（幫助診斷損壞問題）嘗試將代碼復制到新工作簿中，看看那里會發生什么。 如果它在新工作表中運行，那么我不會在它上浪費更多時間而只是重建工作表，相信我，這比解決您擁有的問題要快得多。