web-dev-qa-db-ja.com

フィルター処理されたテーブルの1つの列から表示セルをコピー/貼り付け/計算する

AutoFilterを使用してVBAのテーブルを並べ替えているため、データのテーブルが小さくなります。フィルターが適用された後、1つの列の表示されているセルのみをコピー/貼り付けます。また、1つの列のフィルター処理された値を平均し、結果を別のセルに入れたいと思います。

Stackでこのスニペットを見つけたので、フィルターの表示結果全体をコピー/貼り付けできますが、それを変更する方法や、1列のデータのみ（ヘッダーなし）を取得する別の方法がわかりませんそれ。

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))
excel-vbafiltercopy-pastevbaexcel
9
ruya

次のコードは、A、B、Cの列にCountry、City、Languageを含むSheet1の簡単な3列の範囲を設定します。次のコードは、範囲を自動フィルター処理し、自動フィルター処理されたデータの列の1つだけを別のシートに貼り付けます。これを目的に合わせて変更できるはずです。

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は必要ありません。

14
Jon Crowell

さらに一歩進める必要がある場合にJonのコーディングに追加し、複数の列を実行するには、次のようなものを追加します。

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列のみ、または3列だけをコピーする必要がある場合に役立つと考えました。この同じコーディングを使用して、同じで、コーディングは必要なものをコピーします。

Jonのコメントに直接返信するほどの評判がないので、新しいコメントとして投稿する必要があります。申し訳ありません。

5
MadChadders

ここでは、Windows office 201で動作するコード。このスクリプトは、セルのフィルタリングされた範囲を入力してから、貼り付け範囲を要求します。

両方の範囲のセル数が同じである必要があります。

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

楽しい！

1
Joniale

これが非常にうまく機能することがわかりました。 .autofilterオブジェクトの.rangeプロパティを使用します。これは、かなりあいまいですが、非常に便利な機能のようです：

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
Johnny D