1

我正在研究一个简单的子例程，以从主工作表中提取值并将这些值移动到其他工作表中。当我运行 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
4

2 回答 2

0

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

一世

于 2012-10-17T19:33:49.943 回答
0

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

编译错误：

子或函数未定义

然后突出显示该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以退回到有问题的行。

于 2012-10-17T19:36:49.960 回答