Копирование/вставка / вычисление видимых ячеек из одного столбца отфильтрованной таблицы

Я использую AutoFilter для сортировки таблицы в VBA, что приводит к уменьшению таблице данных. Я только хочу, чтобы скопировать видимые ячейки одного столбца после применения фильтра. Кроме того, я хотел бы усреднить отфильтрованные значения одного столбца и поместить результат в другую ячейку.

Я нашел этот фрагмент в стеке, который позволяет мне копировать / вставлять все видимые результаты фильтра, но я не знаю, как его изменить или другим способом получить стоимость только одного столбца данных (без заголовка) из него.

Range("A1",Cells(65536,Cells(1,256).End(xlToLeft).Column).End(xlUp)).SpecialCells(xlCellTypeVisible).Copy
Sheets("Sheet2").Range("A1").PasteSpecial xlPasteValuesAndNumberFormats
Application.CutCopyMode = False

дополнение к ответу (для вычисления с отфильтрованными значениями):

tgt.Range("B2").Value =WorksheetFunction.Average(copyRange.SpecialCells(xlCellTypeVisible))
7
copy-paste excel excel-vba filter vba

4 ответов

Я создал простую 3-столбец диапазона на Лист1 с страна, город и язык в столбцы A, B и C. следующий код автофильтров, а затем вставляет только один из столбцов данных в отфильтрованном на другой лист. Вы должны иметь возможность изменить это для ваших целей:

Sub CopyPartOfFilteredRange()
    Dim src As Worksheet
    Dim tgt As Worksheet
    Dim filterRange As Range
    Dim copyRange As Range
    Dim lastRow As Long

    Set src = ThisWorkbook.Sheets("Sheet1")
    Set tgt = ThisWorkbook.Sheets("Sheet2")

    ' turn off any autofilters that are already set
    src.AutoFilterMode = False

    ' find the last row with data in column A
    lastRow = src.Range("A" & src.Rows.Count).End(xlUp).Row

    ' the range that we are auto-filtering (all columns)
    Set filterRange = src.Range("A1:C" & lastRow)

    ' the range we want to copy (only columns we want to copy)
    ' in this case we are copying country from column A
    ' we set the range to start in row 2 to prevent copying the header
    Set copyRange = src.Range("A2:A" & lastRow)

    ' filter range based on column B
    filterRange.AutoFilter field:=2, Criteria1:="Rio de Janeiro"

    ' copy the visible cells to our target range
    ' note that you can easily find the last populated row on this sheet
    ' if you don't want to over-write your previous results
    copyRange.SpecialCells(xlCellTypeVisible).Copy tgt.Range("A1")

End Sub

обратите внимание, что при использовании синтаксиса выше для копирования и вставки ничего не выбрано или не активировано (чего всегда следует избегать в Excel VBA), а буфер обмена не используется. В результате Application.CutCopyMode = False is не нужный.

11

просто добавить в кодировку Джона, если вам нужно сделать еще один шаг, и сделать больше, чем один столбец, вы можете добавить что-то вроде 

Dim copyRange2 As Range
Dim copyRange3 As Range

Set copyRange2 =src.Range("B2:B" & lastRow)
Set copyRange3 =src.Range("C2:C" & lastRow)

copyRange2.SpecialCells(xlCellTypeVisible).Copy tgt.Range("B12")
copyRange3.SpecialCells(xlCellTypeVisible).Copy tgt.Range("C12")

поместите их рядом с другими кодировками, которые одинаковы, вы можете легко изменить диапазоны, как вам нужно.

Я добавляю это только потому, что это было полезно для меня. Я бы предположил, что Джон уже знает это, но для тех, кто менее опытен, иногда полезно посмотреть, как изменить/добавить/изменить эти кодировки. Я понял, так как Ruya не знал, как манипулировать исходным кодом, это может быть полезно, если когда-либо нужно было скопировать только 2 столбца visibile или только 3 и т. д. Вы можете использовать то же самое кодирование, добавлять дополнительные строки, которые почти одинаковы, а затем кодирование копирует все, что вам нужно.

У меня недостаточно репутации, чтобы ответить на комментарий Джона напрямую, поэтому я должен опубликовать новый комментарий, извините.

4

Я нашел, что это работает очень хорошо. Он использует .свойство диапазона .объект автофильтра, который кажется довольно неясной, но очень удобной функцией:

Sub copyfiltered()
    ' Copies the visible columns
    ' and the selected rows in an autofilter
    '
    ' Assumes that the filter was previously applied
    '
    Dim wsIn As Worksheet
    Dim wsOut As Worksheet

    Set wsIn = Worksheets("Sheet1")
    Set wsOut = Worksheets("Sheet2")

    ' Hide the columns you don't want to copy
    wsIn.Range("B:B,D:D").EntireColumn.Hidden = True

    'Copy the filtered rows from wsIn and and paste in wsOut
    wsIn.AutoFilter.Range.Copy Destination:=wsOut.Range("A1")
End Sub
0

здесь код, который работает с windows office 2010. Этот скрипт запросит у вас входной отфильтрованный диапазон ячеек, а затем диапазон вставки.

пожалуйста, оба диапазона должны иметь одинаковое количество клеток.

Sub Copy_Filtered_Cells()

Dim from As Variant
Dim too As Variant
Dim thing As Variant
Dim cell As Range

'Selection.SpecialCells(xlCellTypeVisible).Select

    'Set from = Selection.SpecialCells(xlCellTypeVisible)
    Set temp = Application.InputBox("Copy Range :", Type:=8)
    Set from = temp.SpecialCells(xlCellTypeVisible)
    Set too = Application.InputBox("Select Paste range selected cells ( Visible cells only)", Type:=8)



    For Each cell In from
        cell.Copy
        For Each thing In too
            If thing.EntireRow.RowHeight > 0 Then
                thing.PasteSpecial
                Set too = thing.Offset(1).Resize(too.Rows.Count)
                Exit For
            End If
        Next
    Next


End Sub

наслаждайтесь!

0