过滤后VBA选择可见单元格

Question

以下代码应用过滤器并在将某些过滤器应用于表后选择 B 列中的前 10 项。我一直将它用于许多不同的过滤选择，但我遇到了我的过滤器组合之一的问题。

我发现当过滤后 B 列中只有一个项目时，它不会复制那个单元格 - 而是复制整行并且似乎是一个奇怪的选择。

当我手动向此过滤器添加一项（共 2 项）时，它会很好地复制它。当只有一个项目时，为什么此代码不起作用的任何想法？

Sub top10()

Dim r As Range, rC As Range
Dim j As Long

'Drinks top 10
Worksheets("OLD_Master").Columns("A:H").Select
Selection.sort Key1:=Range("H1"), Order1:=xlDescending, Header:=xlGuess, _
    OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
    DataOption1:=xlSortNormal

Worksheets("OLD_Master").Range("A:H").AutoFilter Field:=4, Criteria1:=Array(     _
    "CMI*"), Operator:= _
    xlFilterValues
Worksheets("OLD_Master").Range("A:H").AutoFilter Field:=5,   Criteria1:="Drinks"

Set r = Nothing
Set rC = Nothing
j = 0

Set r = Range("B2", Range("B" &     Rows.Count).End(xlUp)).SpecialCells(xlCellTypeVisible)

For Each rC In r
    j = j + 1
    If j = 10 Or j = r.Count Then Exit For
Next rC

Range(r(1), rC).SpecialCells(xlCellTypeVisible).Copy

Worksheets("For Slides").Range("P29").PasteSpecial
Worksheets("OLD_Master").ShowAllData

End Sub

Answer 1

Rory 很有帮助地指出：

如果您仅将特殊单元格应用于一个单元格，它实际上适用于工作表的整个使用范围。

现在我们知道问题是什么了，我们可以避免它！您使用的代码行SpecialCells：

Set r = Range("B2", Range("B" & Rows.Count).End(xlUp)).SpecialCells(xlCellTypeVisible)

相反，先设置范围，测试它是否只包含一个单元格，然后继续...

Set r = Range("B2", Range("B" & Rows.Count).End(xlUp))
' Check if r is only 1 cell
If r.Count = 1 Then
    r.Copy
Else ' Your previous code
    Set r = r.SpecialCells(xlCellTypeVisible)
    For Each rC In r
        j = j + 1
        If j = 10 Or j = r.Count Then Exit For
    Next rC
    Range(r(1), rC).SpecialCells(xlCellTypeVisible).Copy
End If

请注意，您假设甚至还有一行仍然可见。.End(xlUp)如果没有可见数据，可能会选择第 1 行，您可能也想检查这是第一行！

旁白：你真的应该完全限定你的范围，即而不是

 Set r = Range("B2")

你应该使用

Set r = ThisWorkbook.Sheets("MySheet").Range("B2")

这将在将来为您节省一些令人困惑的错误。您可以使用一些快捷方式，例如使用With块保存重复或声明工作表对象。

' using With blocks
With ThisWorkbook.Sheets("MySheet")
    Set r = .Range("B2")
    Set s = .Range("B3")
    ' ...
End With

' Using sheet objects
Dim sh as Worksheet
Set sh = ThisWorkbook.Sheets("MySheet")
Set r = sh.Range("B2")