我试图找到解决问题的方法,但我无法做到。我找到了一个代码,用于将信息从一个excel文件导入另一个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
提前谢谢!
答案 0 :(得分:2)
我在此行中看到错误
i = 0
Do While ThisWorkbook.Worksheets("Sheet1").Cells(i, 3) <> ""
第一行不能是0
将i = 0
更改为i = 1
,然后重试。
我也看到这些行中的错误
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
您要删除哪一行?你必须提到这一行。例如
Workbooks(filenev).Sheets("auto").Rows(1).Delete
抱歉不禁提出这个建议。我注意到我认为我会指出的一些事情
<强> A 即可。使用Option Explicit
这将确保您声明所有变量。现在,为什么这很重要?使用Option Explicit
A)。它会强制您将变量声明为特定的数据类型。
B)。它会密切关注您的代码,检查输入变量时可能发生的拼写错误。
您可能还想阅读this?
B 使用正确的处理方法。这是必需的,以便您可以捕获错误,更不用说“恢复默认值”
例如,您正在设置Application.Calculation = xlCalculationManual
如果您收到错误会怎样?我会推荐像这样的东西
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