VBA在过滤范围内选择特定的行数

Question

我有一个过滤范围的宏，并且我有一个范围的值，我想代表应用过滤器后被选择的行数。

我对大多数代码进行了排序，即时消息只是停留在选择可见行上。 例如。 表格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的链接，希望可以阐明我的问题。

链接： 样本工作簿

谢谢你的帮助

Answer 1

如果第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列中选择可见材料...........您需要重新调整大小以获取其他列。

Answer 2

您可以使用一个计数器循环：

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