3

我试图找到一种方法来解决我的问题，但我做不到。我找到了一个将信息从一个excel文件导入到另一个文件的代码。我使用工作表命名和列编号对其进行了重新处理，但是当我尝试运行它时，它给了我一个错误：“错误 #1004：应用程序定义的或对象定义的错误。宏将停止”。你能帮我吗？

Private Sub CommandButton1_Click()
On Error GoTo errorhandler
Dim ThisWorkbook As Workbook
Dim ws As Worksheet
Dim RngFleetData, rng As Range
Dim x As Variant
Dim countryN, counnty As String

Dim lReadFirstRow As Long
Dim lReadLastRow As Long
Dim lWriteFirstRow As Long
Dim lWriteLastRow As Long
Dim iRow As Integer
Dim NumOfMonth As Double
filenev = ActiveWorkbook.Name
Application.Calculation = xlCalculationManual
NRRowsRange = 1

 x = Application.GetOpenFilename("Excel Spreadsheets ,*.xls*", , "Open File")
If x = False Then
    Exit Sub
End If

Set ThisWorkbook = Workbooks.Open(x, False, True)

ThisWorkbook.Worksheets("Sheet1").Unprotect

 copied = 0

 j = 1
 Do While Workbooks(filenev).Sheets("auto").Cells(j, 1) <> "fields extract"
 j = j + 1
 Loop
 j = j + 3

 i = 0
 Do While ThisWorkbook.Worksheets("Sheet1").Cells(i, 3) <> ""
    If ThisWorkbook.Worksheets("Sheet1").Cells(i, 1) <> 0 Then

        Workbooks(filenev).Sheets("auto").Cells(j, 1) = ThisWorkbook.Worksheets("Sheet1").Cells(i, 3)
        Workbooks(filenev).Sheets("auto").Cells(j, 2) = ThisWorkbook.Worksheets("Sheet1").Cells(i, 12)
        Workbooks(filenev).Sheets("auto").Cells(j, 3) = ThisWorkbook.Worksheets("Sheet1").Cells(i, 13)
        Workbooks(filenev).Sheets("auto").Cells(j, 4) = ThisWorkbook.Worksheets("Sheet1").Cells(i, 16)
        Workbooks(filenev).Sheets("auto").Cells(j, 5) = ThisWorkbook.Worksheets("Sheet1").Cells(i, 19)
        Workbooks(filenev).Sheets("auto").Cells(j, 6) = ThisWorkbook.Worksheets("Sheet1").Cells(i, 20)
        Workbooks(filenev).Sheets("auto").Cells(j, 7) = ThisWorkbook.Worksheets("Sheet1").Cells(i, 22)
        Workbooks(filenev).Sheets("auto").Cells(j, 8) = ThisWorkbook.Worksheets("Sheet1").Cells(i, 23)
        Workbooks(filenev).Sheets("auto").Cells(j, 9) = ThisWorkbook.Worksheets("Sheet1").Cells(i, 24)
        Workbooks(filenev).Sheets("auto").Cells(j, 10) = ThisWorkbook.Worksheets("Sheet1").Cells(i, 25)
        Workbooks(filenev).Sheets("auto").Cells(j, 11) = ThisWorkbook.Worksheets("Sheet1").Cells(i, 26)
        Workbooks(filenev).Sheets("auto").Cells(j, 12) = ThisWorkbook.Worksheets("Sheet1").Cells(i, 27)
        Workbooks(filenev).Sheets("auto").Cells(j, 13) = ThisWorkbook.Worksheets("Sheet1").Cells(i, 28)
        Workbooks(filenev).Sheets("auto").Cells(j, 14) = ThisWorkbook.Worksheets("Sheet1").Cells(i, 32)
        Workbooks(filenev).Sheets("auto").Cells(j, 15) = ThisWorkbook.Worksheets("Sheet1").Cells(i, 33)
        Workbooks(filenev).Sheets("auto").Cells(j, 16) = ThisWorkbook.Worksheets("Sheet1").Cells(i, 34)
        Workbooks(filenev).Sheets("auto").Cells(j, 17) = ThisWorkbook.Worksheets("Sheet1").Cells(i, 35)
        Workbooks(filenev).Sheets("auto").Cells(j, 18) = ThisWorkbook.Worksheets("Sheet1").Cells(i, 11)


    If ThisWorkbook.Worksheets("Sheet1").Cells(i, 1) = "" Then Workbooks(filenev).Sheets("auto").EntireRow.Delete
       If ThisWorkbook.Worksheets("Sheet1").Cells(i, 2) = 0 Then Workbooks(filenev).Sheets("auto").EntireRow.Delete
       Application.Goto Workbooks(filenev).Sheets("auto").Cells(j, 1)
       ActiveCell.Rows(NRRowsRange).EntireRow.Select
       Selection.Copy
       Selection.Insert Shift:=xlDown
       copied = 1



j = j + 1
End If
i = i + 1
Loop

If copied = 1 Then
ActiveCell.Rows(NRRowsRange).EntireRow.Select
Selection.Delete
Selection.Insert Shift:=xlUp
End If

Application.DisplayAlerts = False
ThisWorkbook.Close False
Application.DisplayAlerts = True


MsgBox "fields has been imported sucessfully!"

  Application.Calculation = xlCalculationAutomatic
Workbooks(filenev).Sheets("auto").Activate

errorhandler:
Select Case Err.Number
Case 9
MsgBox "Hey Buddy, this is NOT the right extract! Macro will STOP", vbExclamation, "STOP"
ThisWorkbook.Close False
Case 0
Case Else
MsgBox "Error # " & Err & " : " & Error(Err) & "Macro will STOP"
End Select
End Sub

先感谢您！

4

1 回答 1

2

I see an error in this line

 i = 0
 Do While ThisWorkbook.Worksheets("Sheet1").Cells(i, 3) <> ""

The first row cannot be 0

Change i = 0 to i = 1 and try again.

I also see an error in these lines

If ThisWorkbook.Worksheets("Sheet1").Cells(i, 1) = "" Then Workbooks(filenev).Sheets("auto").EntireRow.Delete
If ThisWorkbook.Worksheets("Sheet1").Cells(i, 2) = 0 Then Workbooks(filenev).Sheets("auto").EntireRow.Delete

Which row do you want to delete? You have to mention the row. For example

Workbooks(filenev).Sheets("auto").Rows(1).Delete

EDIT

Sorry couldn't help but give this advice. I noticed few things which I thought that I'll point out

A. use Option Explicit This will ensure that you declare all variables. Now, why is this important? There are two main reasons for using Option Explicit

a). It forces you to declare your variables as a specific data type.

b). It keeps a watch on your code checking for spelling mistake that might happen when you type your variable.

You might also want to read this?

B Use proper handling. This is required so that you can trap errors and also not to mention "Restore Defaults"

For example, you are setting Application.Calculation = xlCalculationManual What happens if you get and error? I would recommend something like this

Option Explicit

Private Sub Sample()
    Dim clc As Long

    On Error GoTo errorhandler

    clc = Application.Calculation

    Application.Calculation = xlCalculationManual

    '
    '~~> REST OF YOUR CODE
    '

LetsContinue:
    Application.Calculation = clc '<~~ Reset Calc
    Exit Sub
errorhandler:
    Select Case Err.Number
    Case 9
        MsgBox "Hey Buddy, this is NOT the right extract! Macro will STOP", vbExclamation, "STOP"
        ThisWorkbook.Close False
    Case Else
        MsgBox "Error # " & Err & " : " & Error(Err) & "Macro will STOP"
    End Select
    Resume LetsContinue
End Sub
于 2013-01-21T10:25:29.020 回答