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 很有帮助地指出:

If you apply Specialcells to only one cell, it actually applies to the entire used range of the sheet.

现在我们知道问题所在了，我们可以避免它!使用 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

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

---

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

 Set r = Range("B2")

你应该使用

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

这将为您在将来避免一些令人困惑的错误。您可以采取一些捷径，例如使用 With block 或声明工作表对象来保存重复。

' 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")