VBA过滤后选择可见单元格 [英] VBA selecting visible cells after filtering

问题描述

以下代码将应用过滤器，并在将某些过滤器应用于表之后，选择B列中的前10个项目.我已经在许多不同的过滤选择中使用了此方法，但遇到了我的一种过滤器组合问题.

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列中只有一项时，它不会复制该单元格-而是复制整个行，这似乎是一个奇怪的选择.

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.

当我手动向此过滤器添加一个项目(总计2个)时，它会很好地复制它.关于只有一个项目时为何此代码不起作用的任何想法?

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?

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

推荐答案

Rory指出:

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

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

现在我们知道问题出在哪里，我们可以避免它！您使用SpecialCells的代码行:

Now we know what the problem is, we can avoid it! The line of code where you use 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

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

Note, you're assuming there is even one row 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!

除了:您确实应该完全限定自己的范围，即代替

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

 Set r = Range("B2")

您应该使用

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

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

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

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

这篇关于VBA过滤后选择可见单元格的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！