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

Question

Я использую 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)) 

Answer 1

Я создал простой выбор 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 не требуется.

Answer 2

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

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") 

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

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

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

Answer 3

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

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