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建议的编译选项。在某些情况下，我已经看到重新编译不起作用，如果发生这种情况，只需通过对代码进行更改来强制编译。通常，一个微不足道的变化就足够了。

如果这不起作用（为了帮助解决腐败问题），请尝试将代码复制到新工作簿中，看看那里发生了什么。如果它在新工作表中运行，那么我就不会浪费更多时间在它上面，只是重建工作表，相信我，它会比弄乱你所遇到的问题更快。

运行VBA代码时出现错误否1004

1 个答案: