Question

一直在处理这段代码，仍然无法让它工作。我试图通过搜索和复制类似的代码将它拼凑在一起，但是在复制给出的解决方案时却没有成功。

我有工作表A和工作表B.我在工作表A上有表A，工作表B上有表B.我想自动过滤表A并复制结果（“快速状态”列=“已关闭”）（不包括标题信息））到表B的底部。

如果满足该条件（“快速状态”列=“已关闭”），则将“已关闭”的行复制为“快速状态”列中的条件，并将其粘贴到另一个工作表上，然后删除表A中的数据按预期工作。

但是如果我有一天我没有关闭任何文件，自动过滤器将不会返回任何结果。那是问题发生的时候。当我在调试器中踩到它时 - 它继续通过“IF”部分并被卡在

   Range(Selection, Selection.End(xlDown)).SpecialCells   (xlCellTypeVisible).Copy

不确定为什么它不停在IF部分并向下移动到Else。 If部分应该检测到结果小于1，因此它应该清除过滤器，然后填充一个msg框，通知用户他们当天没有关闭任何文件。

“PendA”是表A的名称。 “快速状态”是表A中列的名称，我正在搜索“已关闭”标准。表A从B14开始。并以列L结束。

Sub MoveC()
'
' MoveC Macro


Dim rng As Range, res As Variant, lrow As Long


Set rng = ActiveSheet.ListObjects("PendA").AutoFilter.Range.Rows(1)
res = Application.Match("Quick Status", rng, 0)
rng.AutoFilter Field:=res, Criteria1:="Closed"

lrow = ActiveSheet.Cells(Rows.Count, res).End(xlUp).Row + 1



If ActiveSheet.Range(Cells(1, res), Cells(lrow, res)).SpecialCells(xlCellTypeVisible).Cells.Count > 1 Then
    Range("B15:L15").Select
    Range(Selection, Selection.End(xlDown)).SpecialCells(xlCellTypeVisible).Copy


    Sheets("Closed").Select
    Range("A2000").End(xlUp).Offset(1, 0).Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False


    Sheets("Pending").Select
    Application.DisplayAlerts = False
    ActiveSheet.ListObjects("PendA").DataBodyRange.Rows.Delete
    ActiveSheet.ListObjects("PendA").Range.AutoFilter Field:=8


Else

    ActiveSheet.ListObjects("PendA").Range.AutoFilter Field:=8

    MsgBox "No Closures found. Should have taken a PTO today."

End If

End Sub

Answer 1

总体而言，有一种更好的方法来构建代码，以实现准确性，可维护性和易读性。

尝试以下方法。它检查＆＃34;已关闭＆＃34;的实例。过滤器列中的列。

Sub MoveC() Dim PendATbl as ListObject Set PendATbl = Worksheets("A").ListObjects("PendA") 'change as needed With PendATbl If Not .ListColumns("Quick Status").DataBodyRange.Find("Closed", lookat:=xlWhole) Is Nothing Then .ListColumns("Quick Status").Range.AutoFilter 1, "Closed" .DataBodyRange.SpecialCells(xlCellTypeVisible).Copy Sheets("Closed").Range("A2000").End(xlUp).Offset(1).PasteSpecial xlPasteValues .DataBodyRange.Rows.Delete Else .Range.AutoFilter Field:=8 MsgBox "No Closures found. Should have taken a PTO today." End If End With End Sub

如果ELSE VBA无法正常工作

1 个答案: