Правильный способ смещения заголовков при циклическом просмотре отфильтрованного списка? - PullRequest
0 голосов
/ 11 марта 2020

В приведенном ниже коде я пытаюсь использовать для l oop через отфильтрованный список. Без смещения l oop проходит через каждое поле и копирует данные несколько раз. Со смещением пропускаемых строк.

Как я могу перефразировать это только в l oop через каждую строку один раз и пропустить строку заголовка?

        'Offset Placement Wrong
        Set rngVisible = activeSheet.AutoFilter.Range.SpecialCells(xlCellTypeVisible).Offset(1, 0)

        For Each rngCell In rngVisible

                    Rows(rngCell.Row).Select
                    Selection.Copy

                    Sheets(2).Select

                    'Skip Headers
                    Cells(2 + rowsRelocated, 1).Select
                    activeSheet.Paste

                    Sheets(1).Select

                    'row increment
                    rowsRelocated = rowsRelocated + 1

         Next

Ответы [ 2 ]

0 голосов
/ 11 марта 2020

Вы можете скопировать сразу все отфильтрованные видимые данные из листов (1) в листы (2) ...

Sub test()

Dim allData As Range, FilteredData As Range, rngVisible As Range, TargetRange As Range

Set allData = Sheets(1).Range("A1").CurrentRegion
'Instead of currentregion you could mention actual range if it contains blank rows.
Set FilteredData = allData.Offset(1, 0).Resize(allData.Rows.Count - 1, allData.Columns.Count)
Set rngVisible = FilteredData.Cells.SpecialCells(xlCellTypeVisible)
Set TargetRange = Sheets(2).Range("A1").CurrentRegion.Offset(Sheets(2).Range("A1").CurrentRegion.Rows.Count, 0)
'Assuming that Row 1 in Sheets(2) is header, Copy visible data from A2
rngVisible.Copy TargetRange

End Sub
0 голосов
/ 11 марта 2020

Ограничить диапазон одним столбцом вашего фильтра.

    Dim rngVisible As Range, RowsRelocated As Long, rngCell As Range
    Set rngVisible = ActiveSheet.AutoFilter.Range.Columns(1).SpecialCells(xlCellTypeVisible)
    RowsRelocated = 0

    For Each rngCell In rngVisible.Cells
         If rngCell.Row > 1 Then
            rngCell.EntireRow.Copy Sheets(2).Cells(2 + RowsRelocated, 1)
            RowsRelocated = RowsRelocated + 1
         End If
    Next
Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...