VBA子程序声明问题,从正确执行中停止Excel VBA

我正在处理一个简单的子例程以从主工作表中提取值并将这些值移动到附加工作表。 当我运行VBAmacros它永远不会超过子程序声明,任何build议将不胜感激。

Option Explicit Sub Macro2() Dim rCell As Range, ws As Worksheet Application.DisplayAlerts = False With Sheets("Sheet1") Sheets.Add().Name = "Temp" .Range("D2", .Range("D" & Rows.Count).End(xlUp)).AdvancedFilter Action:=xlFilterCopy, CopyToRange:=Sheets("Temp").Range("B1"), Unique:=True For Each rCell In Sheets("Temp").Range("D2", Sheets("Temp").Range("B" & Rows.Count).End(xlUp)) If Not IsEmpty(rCell) Then .Range("D2").AutoFilter field:=3, Criteria1:=rCell If SheetExists(rCell.Text) Then Set ws = Sheets(rCell.Text) Else Set ws = Worksheet.Add(After:=Worksheets(Worksheets.Count - 1)) ws.Name = rCell End If With .AutoFilter.Range .Offset(1).Resize(.Rows.Count - 1).Copy ws.Range("A" & Rows.Count).End(xlUp)(2) End With End If Next rCell Sheets("Temp").Delete .AutoFilterMode = False End With Application.DisplayAlerts = True End Sub 

添加function

  Function SheetExists(shtName As String, Optional wb As Workbook) As Boolean Dim sht As Worksheet If wb Is Nothing Then Set wb = ThisWorkbook On Error Resume Next Set sht = wb.Sheets(shtName) On Error GoTo 0 SheetExists = Not sht Is Nothing End Function 

新的错误

 extract range has a illegal or missing field name 

@

 .Range("D2", .Range("D"&Rows.Count).End(xlDown)).AdvancedFilter Action:=xlFilterCopy, CopyToRange:=Sheets("Temp").Range("B1"), Unique:=True 

当我运行该代码时,它说:

编译错误:

子或function未定义

然后突出显示SheetExists函数。 SheetExist是您忘记包含在表单中的函数,或者是您的示例中未包含的自定义函数。

编辑:哇,这里有很多。

如果在此之后再单步执行代码,则还会在这里获得运行时1004错误(“应用程序定义的错误或对象定义的错误”):

 .Range("D2", .Range("D" & Rows.Count).End(xlUp)).AdvancedFilter Action:=xlFilterCopy, CopyToRange:=Sheets("Temp").Range("B1"), Unique:=True 

尝试将其更改为:

 .Range("D2", .Range("D" & Rows.Count).End(xlDown)).AdvancedFilter Action:=xlFilterCopy, CopyToRange:=Sheets("Temp").Range("B1"), Unique:=True 

从那里,改变这一点:

 Set ws = Worksheets.Add(After:=Worksheets(Worksheets.Count - 1)) ws.Name = rCell 

对此:

 Worksheets.Add(After:=Worksheets(Worksheets.Count - 1)).Name = rCell 

从那里,虽然,我不知道With .AutoFilter.Range应该是做什么,除非你的意思With Sheets("Sheet1").AutoFilter.Range

从debugging的angular度来看,你真的想在你的代码的开头添加On Error Goto ErrRoutine ,然后把它添加到你的例程的最后:

  Exit Sub ErrRoutine: MsgBox Err.Description Resume 

并在MsgBox Err.Description上放置一个断点以回到违规行。

你有没有debugging,看看到底在哪里失败。 例如,当您已经存在一个名为Temp的工作表时,您不会尝试添加一个工作表。 debugging并确切地find失败的地方。

一世