我正在开发一个简单的子例程来从主工作表中提取值并将这些值移动到其他工作表。当我运行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
答案 0 :(得分:0)
您是否已调试以查看其失败的确切位置。例如,当一个已存在时,您不会尝试添加名为Temp的工作表。调试并找到它失败的确切位置。
我
答案 1 :(得分:0)
<击> 当我运行该代码时,它会显示:
编译错误:
Sub或Function not defined
然后突出显示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
上设置一个断点,以便退回到违规行。