VBA运行时错误'424'对象所需的问题
我试图将两张表传递给Excel VBA中的一个不同的子例程，以对这些表进行一些操作。 最终，我试图结合多个工作表中的数据，并删除每个列表中find的所有重复数据。 我将其定义为一个对象：
Set wb1 = Workbooks.Open(Pathname & Filename) Set newWB = Workbooks.Add 然后我只是想要一个函数：
Call ThisSubroutine(wb1.Sheets("Sheetnumber1"), newWB.Sheets("Sheet2"))
我得到一个运行时错误'424'对象必需对话框。 我确信这里有一个明显的解决scheme，但我忽略了一些东西。 这个小写是：
Sub ThisSubroutine(Sourcefile As Worksheet, Targetfile As Worksheet)
根据要求，我添加了整个代码：
Sub MergeDuplicates(ByVal DuplicateFilename As String) 'used ByVal because I was getting a "ByRef argument type mismatch" error; don't know why this happens with Dir function, as it should be passing a string, but this seems to fix it, at least as far as compiling the CheckDuplicates Sub 'This one is a bit tricky, but I think the best way to do this is: 'open the original and the duplicate copy (find partial string matches and open both files) Pathname = "\\SRVWIN0791\Daniel_Armstrong$\TM Database Company Files\" 'for now... everything stays in my U drive Set wb1 = Application.Workbooks.Open(Pathname & DuplicateFilename) Dim Partialname As String File = Dir(Pathname) Partialname = Left(DuplicateFilename, 4) Do While File <> "" If StrComp(Left(File, 4), Partialname) = 0 Then Set wb2 = Workbooks.Open(Pathname & File) End If File = Dir() Loop 'Create a new workbook, creates new sheets and name them Set newWB = Workbooks.Add For i = 1 To 6 newWB.Worksheets.Add After:=newWB.Sheets(newWB.Sheets.Count) Next i 'copy the contents of both workbooks into the new one keeping everything on the appropriate sheets Call CopyToNewTMWB(wb1.Sheets("General Information"), newWB.Sheets("Sheet2")) Call CopyToNewTMWB(wb1.Sheets("Markets"), newWB.Sheets("Sheet3")) Call CopyToNewTMWB(wb1.Sheets("Chemistries"), newWB.Sheets("Sheet4")) Call CopyToNewTMWB(wb1.Sheets("Processing Capabilities"), newWB.Sheets("Sheet5")) Call CopyToNewTMWB(wb1.Sheets("Equipment List"), newWB.Sheets("Sheet6")) 'Wrong, should not be using this function here Call CopyToNewTMWB(wb1.Sheets("Analytical & QC"), newWB.Sheets("Sheet7")) Call CopyToNewTMWB(wb1.Sheets("Utilities"), newWB.Sheets("Sheet8")) Call CopyToNewTMWB(wb1.Sheets("Stock Chemicals"), newWB.Sheets("Sheet9")) newWB.Sheets("Sheet2").Name = "General Information" newWB.Sheets("Sheet3").Name = "Markets" newWB.Sheets("Sheet4").Name = "Chemistries" newWB.Sheets("Sheet5").Name = "Processing Capabilities" newWB.Sheets("Sheet6").Name = "Equipment List" newWB.Sheets("Sheet7").Name = "Analytical & QC" newWB.Sheets("Sheet8").Name = "Utilities" newWB.Sheets("Sheet9").Name = "Stock Chemicals" Call AddToNewTMWB(wb2.Sheets("General Information"), newWB.Sheets("General Information")) Call AddToNewTMWB(wb2.Sheets("Markets"), newWB.Sheets("Markets")) Call AddToNewTMWB(wb2.Sheets("Chemistries"), newWB.Sheets("Chemistries")) Call AddToNewTMWB(wb2.Sheets("Processing Capabilities"), newWB.Sheets("Processing Capabilities")) Call AddToNewTMWB(wb2.Sheets("Equipment List"), newWB.Sheets("Equipment List")) 'Wrong.... should not be using this function for this purpose Call AddToNewTMWB(wb2.Sheets("Analytical & QC"), newWB.Sheets("Analytical & QC")) Call AddToNewTMWB(wb2.Sheets("Utilities"), newWB.Sheets("Utilities")) Call AddToNewTMWB(wb2.Sheets("Stock Chemicals"), newWB.Sheets("Stock Chemicals")) 'use excel's built in "remove duplicates" functions on each list Sheet3.Range("A:A").RemoveDuplicates Columns:=1, Header:=xlNo Sheet3.Range("B:B").RemoveDuplicates Columns:=1, Header:=xlNo Sheet4.Range("A:A").RemoveDuplicates Columns:=1, Header:=xlNo Sheet4.Range("B:B").RemoveDuplicates Columns:=1, Header:=xlNo Sheet4.Range("D:D").RemoveDuplicates Columns:=1, Header:=xlNo Sheet5.Range("A:A").RemoveDuplicates Columns:=1, Header:=xlNo Sheet5.Range("B:B").RemoveDuplicates Columns:=1, Header:=xlNo 'This is tricky.... not sure how to handle because there might be minor changes; maybe just don't include it at all...? Sheet6.Range("A:Z").RemoveDuplicates Columns:=Array(1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17, 18, 19, 20, 21, 22, 23, 24), _ Header:=xlYes Sheet7.Range("A:A").RemoveDuplicates Columns:=1, Header:=xlNo Sheet7.Range("B:B").RemoveDuplicates Columns:=1, Header:=xlNo Sheet8.Range("A:A").RemoveDuplicates Columns:=1, Header:=xlNo Sheet8.Range("B:B").RemoveDuplicates Columns:=1, Header:=xlNo Sheet9.Range("A:A").RemoveDuplicates Columns:=1, Header:=xlNo Sheet9.Range("B:B").RemoveDuplicates Columns:=1, Header:=xlNo 'for general information and the equipment list, this is going to be a bit trickier, because the duplicates 'on the equipment list require matching for all 20-some-odd rows and the general information may be actual updates so 'how can I decide what information to update? 'save the old workbooks as "Company Name & City & Date & Old" and "Company Name & City & Date & Duplicate" in a different folder!!!!! wb1.SaveAs filename:="\\SRVWIN0791\Daniel_Armstrong$\TM Duplicate Files\" & DuplicateFilename wb2.SaveAs filename:="\\SRVWIN0791\Daniel_Armstrong$\TM Duplicate Files\" & "Merge " & Format(Date, "dd-mm-yy") & " " & File 'save the newly created workbook as "Company Name & City" in \\SRVWIN0791\Daniel_Armstrong$\TM Database Company Files\ newWB.SaveAs filename:=Pathname & File 'Delete the old files from the "TM Database Company Files" folder End Sub Sub CopyToNewTMWB(SourceSheet As Worksheet, TargetSheet As Worksheet) Dim numRows As Integer, numCols As Integer Dim ActiveRangeOld As Range, ActiveRangeNew As Range 'count cells to define active range numRows = SourceSheet.Cells(Rows.Count, 1).End(xlUp).Row numCols = SourceSheet.Cells(1, Columns.Count).End(xlToLeft).Column Set ActiveRangeOld = SourceSheet.Range(SourceSheet.Cells(1, 1), SourceSheet.Cells(numRows, numCols)) 'set active range equal to appropriate size Set ActiveRangeNew = TargetSheet.Range(TargetSheet.Cells(1, 1), TargetSheet.Cells(numRows, numCols)) 'choose range on new worksheet of same size as above ActiveRangeNew.Value = ActiveRangeOld.Value 'set the new range values equal to the old ones without having to select any cells End Sub Sub AddToNewTMWB(ByVal SourceSheet As Worksheet, ByVal TargetSheet As Worksheet) 'slightly different, just copies the cells to the first unused location Dim numRows As Integer, numCols As Integer Dim ActiveRangeOld As Range, ActiveRangeNew As Range 'count cells to define active range numRows1 = SourceSheet.Cells(Rows.Count, 1).End(xlUp).Row numRows2 = SourceSheet.Cells(Rows.Count, 2).End(xlUp).Row numRowTarget1 = TargetSheet.Cells(Rows.Count, 1).End(xlUp).Row numRowTarget2 = TargetSheet.Cells(Rows.Count, 2).End(xlUp).Row 'write duplicates at end of existing list for new worksheet Set ActiveRangeOld = SourceSheet.Range(SourceSheet.Cells(1, 1), SourceSheet.Cells(numRows1, 1)) 'set active range equal to appropriate size in first column Set ActiveRangeNew = TargetSheet.Range(TargetSheet.Cells(numRowTarget1 + 1, 1), TargetSheet.Cells(numRowTarget1 + numRows1 + 1, 1)) 'choose range on new worksheet of same size as above ActiveRangeNew.Value = ActiveRangeOld.Value 'set the new range values equal to the old ones without having to select any cells 'repeat for 2nd column Set ActiveRangeOld = SourceSheet.Range(SourceSheet.Cells(1, 2), SourceSheet.Cells(numRows1, 2)) 'set active range equal to appropriate size in first column Set ActiveRangeNew = TargetSheet.Range(TargetSheet.Cells(numRowTarget1 + 1, 2), TargetSheet.Cells(numRowTarget1 + numRows1 + 1, 2)) 'choose range on new worksheet of same size as above ActiveRangeNew.Value = ActiveRangeOld.Value 'set the new range values equal to the old ones without having to select any cells End Sub
看看你是否通过对这个重写的修改和评论。 我已经将工作表和单元格范围定义到他们各自的工作簿或工作表中。 所有variables都被显式声明（除非需要，否则不包含变体或对象）。
Sub MergeDuplicates(DuplicateFilename As String) 'This one is a bit tricky, but I think the best way to do this is: 'open the original and the duplicate copy (find partial string matches and open both files) Dim fn As String, pn As String, pfn As String, vVALs As Variant Dim w As Long, wb1 As Workbook, wb2 As Workbook, newWB As Workbook pn = "\\SRVWIN0791\Daniel_Armstrong$\TM Database Company Files\" 'for now... everything stays in my U drive Set wb1 = Application.Workbooks.Open(pn & DuplicateFilename) fn = Dir(pn) pfn = Left(DuplicateFilename, 4) Do While CBool(Len(fn)) If StrComp(Left(fn, Len(pfn)), pfn, vbTextCompare) = 0 Then 'vbTextCompare to remove case sensitive Set wb2 = Workbooks.Open(pn & fn) Exit Do '<no sense continuing if you have what you wa End If fn = Dir() Loop 'Create a new workbook, creates new sheets and name them Set newWB = Workbooks.Add With newWB Do While .Worksheets.Count < 9 'who says every new workbook has three worksheets? Mine has one. .Worksheets.Add After:=.Sheets(.Sheets.Count) Loop End With 'copy the contents of both workbooks into the new one keeping everything on the appropriate sheets Call CopyToNewTMWB(wb1.Sheets("General Information"), newWB.Sheets("Sheet2")) Call CopyToNewTMWB(wb1.Sheets("Markets"), newWB.Sheets("Sheet3")) Call CopyToNewTMWB(wb1.Sheets("Chemistries"), newWB.Sheets("Sheet4")) Call CopyToNewTMWB(wb1.Sheets("Processing Capabilities"), newWB.Sheets("Sheet5")) Call CopyToNewTMWB(wb1.Sheets("Equipment List"), newWB.Sheets("Sheet6")) 'Wrong, should not be using this function here Call CopyToNewTMWB(wb1.Sheets("Analytical & QC"), newWB.Sheets("Sheet7")) Call CopyToNewTMWB(wb1.Sheets("Utilities"), newWB.Sheets("Sheet8")) Call CopyToNewTMWB(wb1.Sheets("Stock Chemicals"), newWB.Sheets("Sheet9")) 'new worksheet renaming moved to CopyToNewTMWB 'not sure what the parent workbook is... I'm guessing hte newly added one. With newWB 'use excel's built in "remove duplicates" functions on each list vVALs = Array("General Information", "Markets", "Chemistries", _ "Processing Capabilities", "Analytical & QC", _ "Utilities", "Stock Chemicals") For w = LBound(vVALs) To UBound(vVALs) With .Worksheets(vVALs(w)) .Range("A:A").RemoveDuplicates Columns:=1, Header:=xlNo .Range("B:B").RemoveDuplicates Columns:=1, Header:=xlNo End With Next w vVALs = Array(1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17, 18, 19, 20, 21, 22, 23, 24) 'leave the brackets surrounding (vVALs) in hte next statement. They are important. With Worksheets("Equipment List") '<-Sheet6 .Range("A:Z").RemoveDuplicates Columns:=(vVALs), Header:=xlYes End With End With 'for general information and the equipment list, this is going to be a bit trickier, because the duplicates 'on the equipment list require matching for all 20-some-odd rows and the general information may be actual updates so 'how can I decide what information to update? 'save the old workbooks as "Company Name & City & Date & Old" and "Company Name & City & Date & Duplicate" in a different folder!!!!! wb1.SaveAs Filename:="\\SRVWIN0791\Daniel_Armstrong$\TM Duplicate Files\" & DuplicateFilename 'Is this the only thing that wb2 is used for? What if it was never found? On Error Resume Next wb2.SaveAs Filename:="\\SRVWIN0791\Daniel_Armstrong$\TM Duplicate Files\" & "Merge " & Format(Date, "dd-mm-yy") & " " & fn 'save the newly created workbook as "Company Name & City" in \\SRVWIN0791\Daniel_Armstrong$\TM Database Company Files\ newWB.SaveAs Filename:=pn & fn 'Delete the old files from the "TM Database Company Files" folder End Sub Sub CopyToNewTMWB(SourceSheet As Worksheet, TargetSheet As Worksheet) Dim numRows As Long, numCols As Long Dim ActiveRangeOld As Range, ActiveRangeNew As Range 'count cells to define active range With SourceSheet numRows = .Cells(Rows.Count, 1).End(xlUp).Row numCols = .Cells(1, Columns.Count).End(xlToLeft).Column Set ActiveRangeOld = .Range(.Cells(1, 1), .Cells(numRows, numCols)) 'set active range equal to appropriate size End With With TargetSheet Set ActiveRangeNew = .Range(.Cells(1, 1), .Cells(numRows, numCols)) 'choose range on new worksheet of same size as above .Name = SourceSheet.Name End With ActiveRangeNew = ActiveRangeOld.Value 'set the new range values equal to the old ones without having to select any cells End Sub
请注意，我将新工作表重命名为CopyToNewTMWB例程。 既然你既旧又新，需要同步他们的名字，这似乎是保存一些代码行的合适方法。
感谢大家的帮助。 我习惯了Locals窗口来检查我的工作簿variables的属性，并意识到wb1没有分配。 不是在顶部的Do循环中find原始文件，而是再次find重复的文件并将其重新分配给wb2。 愚蠢的错误，应该早日捡起来。 我将该循环中的If语句更改为：
Do While File <> "" If StrComp(Left(File, 4), Partialname) = 0 And StrComp(File, DuplicateFilename) <> 0 Then 'partially matching filenames will enter this if statement, but not exact matches. Can't have files with the exact same name in the same folder anyway, so this will also pick up "filename" matched with "filename(1)", but will not reassign wb2 when it finds "filename" Set wb2 = Workbooks.Open(Pathname & File) wb2found = True Exit Do End If File = Dir() Loop
道德：424对象所需的错误就是这样。