Excel VBA选择筛选范围上的特定行数

我有一个过滤范围的宏，我有一个值范围，我想表示应用过滤器后选择的行数

我已经对大部分代码进行了排序，我只是停留在只选择可见行上。 表1包含可变数字（1、2、3、4等），我将其标记为NOC1

现在，应用过滤器后，它会选择正确的行数，但也会选择隐藏的单元格。我只希望它只选择可见的单元格

代码如下：

Set TopVisibleCell = Rstatus.Offset(1).Rows.SpecialCells(xlCellTypeVisible).Rows(1)
TopVisibleCell.Select
Selection.Resize(Selection.Rows.Count + NOC1 - 1, _
Selection.Columns.Count).Copy

任何帮助都将不胜感激

谢谢

编辑：

请原谅我描述得不好，我似乎没有表达清楚。 请找到Sample.xlsm的链接，这将有助于了解我的问题

链接：

感谢您的帮助

如果第#1行是标题行，并且您希望选择自动筛选的可见范围，并且A列中的筛选下方没有“垃圾”，则：

Sub SelectVisibleA()
    Dim NLastVisible As Long, r As Range
    NLastVisible = Cells(Rows.Count, "A").End(xlUp).Row
    Set r = Range("A2:A" & NLastVisible).Cells.SpecialCells(xlCellTypeVisible)
    r.Select
End Sub

---

将选择列A中的可见材质。您需要调整大小以获得其他列。

您可以使用计数器循环：

Sub FilterCDA()
   Dim sh1                         As Worksheet
   Dim N                           As Long
   Dim TopVisibleCell              As Range
   Dim sh2                         As Worksheet
   Dim HeaderRow                   As Long
   Dim LastFilterRow               As Long
   Dim st                          As String
   Dim rng1                        As Range
   Dim rng2                        As Range
   Dim rng3                        As Range
   Dim VTR                         As String
   Dim W                           As Integer
   Dim R                           As Integer
   Dim NOC                         As Range
   Dim NOC1                        As Integer
   Dim rSelect                     As Range
   Dim rCell                       As Range


   Set sh1 = Sheets("Request")
   Set sh2 = Sheets("Request")

   C = 2
   Set NOC = sh2.Range("D2")
   NOC1 = NOC.Value

   LR = Worksheets("ORT").Range("A" & Rows.Count).End(xlUp).Row
   Set Rstatus1 = Worksheets("ORT").Range("G2:G" & LR)
   Set Rstatus = Worksheets("ORT").Range("A1:G" & LR)
   N = sh1.Cells(Rows.Count, "C").End(xlUp).Row

   Sheets("CSV").Cells.NumberFormat = "@"
   For i = 2 To N
      v = sh1.Cells(i, 3).Value
      If v <> "" Then
         st = st & v & ","
      End If
   Next i
   st = Mid(st, 1, Len(st) - 1)
   Arr1 = Split(st, ",")
   Sheets("ORT").Activate
   For i = LBound(Arr1) To UBound(Arr1)
      Sheets("ORT").AutoFilterMode = False
      With Sheets("ORT").Range("A:G")
         .AutoFilter Field:=3, Criteria1:=Arr1(i), Operator:=xlFilterValues
      End With

      Fr = Worksheets("ORT").Range("C" & Rows.Count).End(xlUp).Row - 1

      ' No rows filtered then Fr = 0

      If Fr > 0 Then

         With Rstatus
            Set rVis = .Resize(.Rows.Count - 1, 1).Offset(1).SpecialCells(xlCellTypeVisible)
         End With

         For Each rCell In rVis.Cells
            If rSelect Is Nothing Then
               Set rSelect = rCell.Resize(, Rstatus.Columns.Count)
            Else
               Set rSelect = Union(rSelect, rCell.Resize(, Rstatus.Columns.Count))
            End If
            lCounter = lCounter + 1
            If lCounter >= NOC1 Then Exit For
         Next rCell

         rSelect.Copy
         Sheets("CSV").Cells(Rows.Count, "A").End(xlUp).Offset(1).PasteSpecial xlPasteValues

      ElseIf Fr = 0 Then
      End If

      Set NOC = NOC.Offset(1)
      NOC1 = NOC.Value
   Next i
   Sheets("ORT").AutoFilterMode = False

   Sheets("Request").Select
   Range("E2").Select
   ActiveCell.FormulaR1C1 = "=COUNTIF('CSV'!C[-2],'Request'!RC[-2])"
   On Error Resume Next
   Selection.AutoFill Destination:=Range("E2:E" & Range("C" & Rows.Count).End(xlUp).Row), Type:=xlFillCopy
   Columns("E:E").Select
   Selection.Copy
   Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
                                                                   :=False, Transpose:=False

   Range("A1").Select
   Sheets("Control").Select
   Range("A1").Select


End Sub

Sub-FilterCDA（）
Dim sh1作为工作表
长
暗淡的顶部可视单元格作为范围
Dim sh2 As工作表
昏头
暗淡的最后一个过滤器如长
暗线
变暗rng1 As范围
变暗rng2 As范围
变暗rng3 As范围
将录像机变暗为字符串
作为整数的Dim W
作为整数的Dim R
暗NOC As范围
作为整数的Dim NOC1
调光选择范围
变暗rCell As范围
设置sh1=图纸（“请求”）
设置sh2=图纸（“请求”）
C=2
设置NOC=sh2.量程（“D2”）
NOC1=NOC.值
LR=工作表（“ORT”）.Range（“A”和Rows.Count）.End（xlUp）.Row
设置Rstatus1=工作表（“ORT”）。范围（“G2:G”和LR）
设置Rstatus=工作表（“ORT”）。范围（“A1:G”和LR）
N=sh1.单元格（Rows.Count，“C”）.结束（xlUp）.行
工作表（“CSV”）.Cells.NumberFormat=“@”
对于i=2到N
v=sh1.单元（i，3）.值
如果v“那么
st=st&v&“
如果结束
接下来我
st=中间（st，1，Len（st）-1）
Arr1=拆分（st，“，”）
工作表（“ORT”）。激活
对于i=LBound（Arr1）到UBound（Arr1）
工作表（“ORT”）。AutoFilterMode=False
带板材（“ORT”）。范围（“A:G”）
.AutoFilter字段：=3，准则1:=Arr1（i），运算符：=xlFilterValues
以
Fr=工作表（“ORT”）。范围（“C”和行数。计数）。结束（xlUp）。行-1
'未筛选行，则Fr=0
如果Fr>0，则
与瑞斯塔斯
设置rVis=.Resize（.Rows.Count-1,1）.Offset（1）.SpecialCells（xlCellTypeVisible）
以
rVis.单元格中的每个rCell
如果rSelect什么都不是，那么
Set rSelect=rCell.Resize（，Rstatus.Columns.Count）
其他的
Set rSelect=Union（rSelect，rCell.Resize（，Rstatus.Columns.Count））
如果结束
l计数器=l计数器+1
如果lCounter>=NOC1，则退出
下一个rCell
R选择，收到
表格（“CSV”）。单元格（行数，“A”）。结束（xlUp）。偏移量（1）。粘贴特殊xlPasteValues
ElseIf Fr=0，则
如果结束
设置NOC=NOC偏移量（1）
NOC1=NOC.值
接下来我
工作表（“ORT”）。AutoFilterMode=False
表格（“请求”）。选择
范围（“E2”）。选择
ActiveCell.FormulaR1C1=“=COUNTIF（'CSV'！C[-2]，'Request'！RC[-2]）”
出错时继续下一步
Selection.AutoFill Destination:=Range（“E2:E”和Range（“C”和Rows.Count）。End（xlUp.Row），Type:=xlFillCopy
列（“E:E”）。选择
选择，复制
Selection.Paste特殊粘贴：=xlPasteValues，操作：=xlNone，SkipBlank_
：=假，转置：=假
范围（“A1”）。选择
工作表（“控件”）。选择
范围（“A1”）。选择
端接头

谢谢你的回复，也许我原来的帖子不清楚。我知道如何选择所有可见单元格，但如何在筛选范围内选择“X”数量的可见行？假设“X”是一个变量，并且每次都会改变。Thanks@user2298601：在我的示例中，r是单个列中的一个范围。。。。。。。。。。r（7）将是第七个可见单元格，因此r（7）。EntireRow将是第七个可见行。。。。。。UNION（r（2），r（3））将是第二个和第三个可见细胞，等等。@Gary的学生r（7）相当于r.cells（7），这不仅仅限于可见细胞。您必须为每个循环使用一个

，请参见编辑并链接到示例工作簿。我为我在最初的帖子中没有完全清楚而道歉。感谢you@Gary的学生请参见编辑和链接到示例工作簿。我为我在最初的帖子中没有完全清楚而道歉。感谢you@user2298601代码已被更改以匹配您的工作簿：-）它在我给您的示例中非常有效，但它返回的值似乎比NOC1值低很多。。在我再次打扰你之前，我会试试看我能做些什么：）