Вопрос

I have a macro that filters a range, and I have a range of values which I want to represent the number of rows being selected after the filter is applied.

I have most of the code sorted, im just getting stuck on selecting the visible rows only. EG. Sheet 1 contains variable numbers (1, 2, 3 ,4 etc) which I have labelled as NOC1.

Now once the filter is applied it selects the correct number of rows, but also selects hidden cells. I just want it to select the visible cells only.

Here is the code:

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

Any help would be greatly appreciated.

Thanks!

Edit:

Please excuse my poor description, it seems I didnt express myself clearly. Please find link to Sample.xlsm which will hopefully shed some light on my problem.

Link : Sample Workbook

Thanks for your help

Это было полезно?

Решение

you can loop with a counter:

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

Другие советы

If row #1 is the header row and you want to select the visible range of the AutoFilter and there is no "junk" below the filter in column A then:

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

will select the visible material in column A...........you need to RESIZE to get additional columns.

Лицензировано под: CC-BY-SA с атрибуция
Не связан с StackOverflow
scroll top