Question

我在执行过滤数据的复制+粘贴时遇到问题。如果过滤字段的结果为0或者＆gt;我的代码不会遇到错误1.但是，如果在过滤后显示1条记录，则会出现运行时错误6。请参阅下面使用的代码：

Dim wsDue As Worksheet
Dim wsTarget As Worksheet
Dim y As Long
Dim x As Long

x = Range("A65536").End(xlUp).Row

Range("A1").AutoFilter Field:=2, Criteria1:=Array("Yes"), Operator:=xlFilterValues
Set wsDue = Worksheets("Due")
Set wsTarget = Worksheets("Target List Consolidated")
y = wsDue.Range("B" & wsDue.Rows.Count).End(xlUp).Row

If wsDue.Range(wsDue.Cells(2, 2), wsDue.Cells(y, 2)).SpecialCells(xlCellTypeVisible).Count > 1 Then
    wsDue.Range("B2:B" & x).Copy
    wsTarget.Range("A65536").End(xlUp).Offset(1).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False
Else:
End If

Answer 1

首先，请确保您的Excel（也称为MS-Office）具有所有适用的服务包。将单个筛选行解释为所有行的问题是已知错误，但在后续服务包中已得到纠正。

您还可以应用一些“最佳做法”代码，以避免它完全发生。 Range.CurrentRegion property可用于本地化Range.AutoFilter Method。使用渐进式With ... End With statements进一步隔离要传输的数据。

Dim wsDue As Worksheet, wsTarget As Worksheet

With Worksheets("Due")
    If .AutoFilterMode Then .AutoFilterMode = False
    'work on the contiguous block of cells radiating out from A1
    With .Cells(1, 1).CurrentRegion
        'apply the AutoFilter
        .AutoFilter Field:=2, Criteria1:=Array("Yes"), Operator:=xlFilterValues
        'shift one row down (off the header row) and resize one less row
        'isolate column B
        With .Offset(1, 1).Resize(.Rows.Count - 1, 1)
            'non-destructive test to see if there are any rows visible
            If CBool(Application.Subtotal(103, .Cells)) Then
                Set wsTarget = Worksheets("Target List Consolidated")
                .Copy
                wsTarget.Range("A65536").End(xlUp).Offset(1).PasteSpecial _
                    Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False
            End If
        End With
    End With
End With

Answer 2

我想出了另一种解决方案。我改为使用以下代码：

Dim x As Long
Dim wsDue As Worksheet
Dim wsTarget As Worksheet

x = Range("A65536").End(xlUp).Row
Range("A1").AutoFilter Field:=2, Criteria1:=Array("Yes"), Operator:=xlFilterValues
Set wsDue = Worksheets("Due")
Set wsTarget = Worksheets("Target List Consolidated")

If wsDue.Range("B1:B" & x).Offset(1, 0).SpecialCells(xlCellTypeVisible).Count > 1 Then
    wsDue.Range("B1:B" & x).Offset(1, 0).SpecialCells(xlCellTypeVisible).Copy
    wsTarget.Range("A65536").End(xlUp).Offset(1).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False
    Application.CutCopyMode = False
    Application.DisplayAlerts = False
Else:
End If

该解决方案能够获得过滤器的结果，并将复制除第1行中标题之外的所需范围。

运行时错误6 - 溢出，变量设置为Long

2 个答案: