VBA过滤后选择可见单元格

Posted 2023-03-10

【中文标题】VBA过滤后选择可见单元格

【英文标题】：VBA selecting visible cells after filtering

【发布时间】：2017-08-21 07:03:39

【问题描述】：

以下代码应用过滤器并在将某些过滤器应用于表格后选择 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

【问题讨论】：

如果你只对一个单元格应用Specialcells，它实际上会应用到工作表的整个使用范围。您应该在使用前测试计数。

【参考方案1】：

Rory 很有帮助地指出：

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

现在我们知道问题所在了，我们可以避免它！使用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 块保存重复或声明工作表对象。

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

【参考方案2】：

感谢@Rory

Specialcells

不适用于选定的一个单元格。通过执行以下操作进行调整：

......

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

If j = 1 Then
    Range(r(1), rC).Copy
Else
    Range(r(1), rC).SpecialCells(xlCellTypeVisible).Select
End If

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

End Sub

【讨论】：

不应该是：Range(r(1), rC).SpecialCells(xlCellTypeVisible).Copy？