VBA 子例程声明问题阻止 excel VBA 正确执行

Question

我正在开发一个简单的子例程，以从主工作表中提取值并将这些值移动到其他工作表中。当我运行 VBA 宏时，它永远不会超过子例程声明，任何建议都将不胜感激。

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 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

Answer 1

当我运行该代码时，它说：

编译错误：

子或函数未定义

然后突出显示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。

从调试的角度来看，您确实想在代码开头添加On Error Goto ErrRoutine，然后将其添加到例程的末尾：

    Exit Sub

ErrRoutine:

    MsgBox Err.Description
    Resume

并在MsgBox Err.Description 上设置断点以退回到有问题的行。

Answer 2

您是否进行了调试以查看失败的确切位置。例如，您不会尝试在已经存在的情况下添加名为 Temp 的工作表。调试并找出失败的确切位置。

我