-1

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
4

1 に答える 1

0

壊れたコード キャッシュのように聞こえます。

古い形式 (xls) のワークブックでこのようなエラーが発生するのを見たことがありますが、これはファイル全体の問題の兆候である可能性があります。

最初に @Scott Holtzman によって提案されたコンパイル オプションを試してください。場合によっては、再コンパイルが機能しないことがわかりました。その場合は、コードに変更を加えて強制的にコンパイルしてください。通常は些細な変更で十分です。

それでもうまくいかない場合は (破損の問題を診断するために)、コードを新しいワークブックにコピーして、そこで何が起こるかを確認してください。それが新しいシートで実行される場合、私はそれ以上の時間を無駄にせず、シートを再構築するだけです.

于 2012-12-14T21:45:33.390 に答える