应用程序定义的或对象定义的错误（1004） – Excel VBA
我有一个名为“ EvaluationLog.xlsm ”的工作簿，我需要将第一个工作表中的特定单元格（不是整行）转移到位于同一目录中的另一个名为“ IndicatorLog.xlsm ”的现有工作簿。 目标工作表也是第一个。 我正在尝试将macros寄存在“ IndicatorLog ”工作簿中。
如果列“O”中的内容是“否”或列“J”的内容是“初始”，则仅从源复制特定单元格。 实际的源数据从第8行开始，目标范围也从第8行开始。
我有两个问题。 第一个是，我在第一行尝试复制单元格的时候遇到了这个错误“应用程序定义或对象定义的错误（1004）”。
这是行： TargetSheet.Range("A" & NRow).Value = WorkBk.ActiveSheet.Range(“A” & i).Value
第二个问题是，当我已经打开源代码工作簿时，即使我有一个函数试图避免这个问题，我仍然会尝试打开它。 🙁
我将macros分配给一个表单button。 任何帮助将不胜感激！ 🙂
这里是两个Excel文件：
档
代码如下：
Sub MergeFromLog() Dim TargetSheet As Worksheet Dim NRow As Long Dim SourceFileName As String Dim WorkBk As Workbook Dim LastRow As Integer, i As Integer, erow As Integer ' Set destination file. Set TargetSheet = ActiveWorkbook.Worksheets(1) ' Set source file. SourceFileName = ActiveWorkbook.Path & "\2015-2016 Evaluation Log.xlsm" ' NRow keeps track of where to insert new rows in the destination workbook. NRow = 8 ' Open the source workbook in the folder If CheckFileIsOpen(SourceFileName) = False Then Set WorkBk = Workbooks.Open(SourceFileName) Else Set WorkBk = Workbooks(SourceFileName) End If LastRow = WorkBk.ActiveSheet.Cells(Rows.Count, "A").End(xlUp).Row For i = 8 To LastRow If WorkBk.ActiveSheet.Range("O" & i) = "No" Or WorkBk.ActiveSheet.Range("J" & i) = "Initial" Then ' Copy Student Name TargetSheet.Range("A" & NRow).Value = WorkBk.ActiveSheet.Range(“A” & i).Value ' Copy DOB TargetSheet.Range("B" & NRow).Value = WorkBk.ActiveSheet.Range(“C” & i).Value ' Copy ID# TargetSheet.Range("C" & NRow).Value = WorkBk.ActiveSheet.Range(“D” & i).Value ' Copy Consent Day TargetSheet.Range("D" & NRow).Value = WorkBk.ActiveSheet.Range(“L” & i).Value ' Copy Report Day TargetSheet.Range("E" & NRow).Value = WorkBk.ActiveSheet.Range(“N” & i).Value ' Copy FIE within District Timelines? TargetSheet.Range("F" & NRow).Value = WorkBk.ActiveSheet.Range(“O” & i).Value ' Copy Qualified? TargetSheet.Range("H" & NRow).Value = WorkBk.ActiveSheet.Range(“A” & i).Value ' Copy Primary Eligibility TargetSheet.Range("I" & NRow).Value = WorkBk.ActiveSheet.Range(“U” & i).Value ' Copy ARD Date TargetSheet.Range("J" & NRow).Value = WorkBk.ActiveSheet.Range(“R” & i).Value ' Copy ARD within District Timelines? TargetSheet.Range("K" & NRow).Value = WorkBk.ActiveSheet.Range(“S” & i).Value ' Copy Ethnicity TargetSheet.Range("M" & NRow).Value = WorkBk.ActiveSheet.Range(“F” & i).Value ' Copy Hisp? TargetSheet.Range("N" & NRow).Value = WorkBk.ActiveSheet.Range(“G” & i).Value ' Copy Diag/LSSP TargetSheet.Range("O" & NRow).Value = WorkBk.ActiveSheet.Range(“X” & i).Value NRow = NRow + 1 End If Next i End Sub Function CheckFileIsOpen(chkSumfile As String) As Boolean On Error Resume Next CheckFileIsOpen = UCase(Workbooks(chkSumfile).Name) Like UCase(chkSumfile) On Error GoTo 0 End Function
您可以利用很less使用的错误控制Resume 。
Sub MergeFromLog2() Dim SourceSheet As Worksheet, TargetSheet As Worksheet Dim SourceFileName As String Dim LastRow As Long, i As Long, NRow As Long ' Set destination file. Set TargetSheet = ThisWorkbook.Worksheets(1) NRow = TargetSheet.Cells(Rows.Count, 1).End(xlUp).Row + 1 ' Set source file. On Error GoTo CheckWbIsOpen SourceFileName = ThisWorkbook.Path & "\2015-2016 Evaluation Log.xlsm" 'Try to work on it as if it was open. If it is closed an error will be thrown and it will be opened and control will be returned back here Set SourceSheet = Workbooks(Trim(Right(Replace(SourceFileName, "\", Space(99)), 99))).Worksheets(1) On Error GoTo 0 With SourceSheet Debug.Print .Name LastRow = .Cells(Rows.Count, "A").End(xlUp).Row For i = 8 To LastRow If .Range("O" & i) = "No" Or .Range("J" & i) = "Initial" Then ' Copy Student Name TargetSheet.Range("A" & NRow).Value = .Range("A" & i).Value ' Copy DOB TargetSheet.Range("B" & NRow).Value = .Range("C" & i).Value ' Copy ID# TargetSheet.Range("C" & NRow).Value = .Range("D" & i).Value ' Copy Consent Day TargetSheet.Range("D" & NRow).Value = .Range("L" & i).Value ' Copy Report Day TargetSheet.Range("E" & NRow).Value = .Range("N" & i).Value ' Copy FIE within District Timelines? TargetSheet.Range("F" & NRow).Value = .Range("O" & i).Value ' Copy Qualified? TargetSheet.Range("H" & NRow).Value = .Range("A" & i).Value ' Copy Primary Eligibility TargetSheet.Range("I" & NRow).Value = .Range("U" & i).Value ' Copy ARD Date TargetSheet.Range("J" & NRow).Value = .Range("R" & i).Value ' Copy ARD within District Timelines? TargetSheet.Range("K" & NRow).Value = .Range("S" & i).Value ' Copy Ethnicity TargetSheet.Range("M" & NRow).Value = .Range("F" & i).Value ' Copy Hisp? TargetSheet.Range("N" & NRow).Value = .Range("G" & i).Value ' Copy Diag/LSSP TargetSheet.Range("O" & NRow).Value = .Range("X" & i).Value NRow = NRow + 1 End If Next i Application.DisplayAlerts = False .Parent.Close False End With GoTo Safe_Exit CheckWbIsOpen: i = i + 1 If i > 1 Then 'tried once and failed - do not keep trying to open something that doesn't want to be opened Debug.Print "Unable to open: " & SourceFileName Exit Sub End If Workbooks.Open Filename:=SourceFileName, ReadOnly:=True Resume '<- this sends control back to the line that threw the error Safe_Exit: Set SourceSheet = Nothing Set TargetSheet = Nothing Application.DisplayAlerts = True End Sub
使用Resume陷阱错误完全否定了您的function需求。
改变你的函数调用：
Function CheckFileIsOpen(chkSumfile As String) As Boolean Dim ret ret = False On Error Resume Next ret = (Workbooks(chkSumfile).Name <> "") CheckFileIsOpen = ret End Function
否则，用VBA来讽刺名字的巧妙的引号是不行的（或者根本不工作）。 修复那些正常的引号应该照顾它。