vba 过滤后VBA选择可见单元格

VBA selecting visible cells after filtering

提问by wra

The following code applies filters and selects the top 10 items in column B after some filters are applied to the table. I have been using this for many different filtered selection, but I came across a problem with one of my filter combinations.

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

I found that when there is only one item in column B after filtering, it doesn't copy that one cell - instead it copies the entire row and seems to be a strange selection.

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

When I manually add one more item to this filter (total 2), then it copies it fine. Any ideas on why this code won't work when there is only one item?

当我手动向此过滤器添加一项（共 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

回答by Wolfie

Rory helpfully points out:

Rory 很有帮助地指出：

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

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

Now we know what the problem is, we can avoid it! The line of code where you use SpecialCells:

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

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

Instead, set the range first, test if it only contains one cell, then proceed...

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

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

Note, you're assuming there is even onerow still visible. It might be that the .End(xlUp)selects row 1 if there is no visible data, you may want to check which row this is first too!

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

---

---

Aside: You really should be fully qualifying your ranges, i.e. instead of

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

 Set r = Range("B2")

You should use

你应该使用

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

This will save you some confusing errors in future. There are shortcuts you can take, for example saving repetition using Withblocks or declaring sheet objects.

这将在将来为您节省一些令人困惑的错误。您可以使用一些快捷方式，例如使用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")

回答by wra

Thank you to @Rory

谢谢@Rory

Specialcells

Doesn't work with one cell selected. Adapted by doing the following:

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

......

......

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