1

我正在使用excel的数据库功能。见示例图片

在此处输入图像描述

我使用 vba 来选择有“是”的记录让我们说 A

Selection.AutoFilter Field:=2, Criteria1:="yes"
Range("B3").Select
Range(Selection, Selection.End(xlDown)).Select

然后我将其复制并粘贴到其他地方。例如：

Selection.Copy
Range("B12").Select
ActiveSheet.Paste

问题是，当没有记录时，我得到错误 1004。可能是因为没有要粘贴的内容。我如何编写脚本，以便如果没有要粘贴的内容，它会退出子程序？

我尝试过counta之类的东西，但没有成功。

非常感谢您的帮助！:)

4

3 回答 3

2

我喜欢这样做，因为您不需要对其进行错误检查。如果没有结果，它将简单地粘贴一个空白单元格：

Sub tgr()

    With Range("B2").CurrentRegion
        .AutoFilter 2, "yes"
        Intersect(.Offset(1), Columns("B")).Copy Range("B12")
        .AutoFilter
    End With

End Sub

或者，如果您只有一个条件，则可以在执行过滤器之前使用 Countif 测试条件是否存在：

Sub tgr()

    Dim strCriteria As String

    strCriteria = "yes"

    With Range("B2").CurrentRegion
        If WorksheetFunction.CountIf(Intersect(.Cells, Columns("C")), strCriteria) > 0 Then
            .AutoFilter 2, strCriteria
            Intersect(.Offset(1), Columns("B")).Copy Range("B12")
            .AutoFilter
        Else
            MsgBox "No cells found to contain """ & strCriteria & """", , "No Matches"
        End If
    End With

End Sub
于 2013-08-16T14:43:54.540 回答
1

这将在应用自动筛选后检查可见单元格的数量：

Selection.AutoFilter Field:=2, Criteria1:="yes"
If ActiveSheet.AutoFilter.Range.Rows.Offset(1, 0).SpecialCells(xlCellTypeVisible).Count - ActiveSheet.AutoFilter.Range.Columns.Count > 0 Then
    Range("B3").Select
    Range(Range("b3"), Range("b2").End(xlDown)).Select
    Selection.Copy
    Range("B12").Select
    ActiveSheet.Paste
End If

该- ActiveSheet.AutoFilter.Range.Columns.Count部分是从计数中减去标题单元格。

FWIW，当我浏览您的原始代码时，我得到了 1004，因为复制区域是从 B7 到工作表底部（xlDown 在空选择中的效果）。

于 2013-08-16T14:36:47.773 回答
0

您可以使用 SUBTOTAL 工作表函数来计算可见行，并且只有在存在可见行时才进行复制和粘贴。这是一个例子。

Sub CopyFiltered()

    Dim rToFilter As Range
    Dim rToCopy As Range
    Dim rToPaste As Range

    Set rToFilter = Selection
    Set rToPaste = rToFilter.Cells(1).Offset(10, 0) 'paste it 10 rows down

    rToFilter.AutoFilter 2, "yes"

    'Use subototal to count the visible rows in column 1
    If Application.WorksheetFunction.Subtotal(2, rToFilter.Columns(1)) > 0 Then
        'Copy excluding the header row
        Set rToCopy = rToFilter.Columns(1).Offset(1, 0).Resize(rToFilter.Rows.Count - 1)
        rToCopy.Copy Destination:=rToPaste
    End If

End Sub
于 2013-08-16T14:57:15.217 回答