2

他のアプリケーションで使用するために、行と列のサブセットをソーステーブルからクリップボードに自動的にコピーしようとしています。テーブルのヘッダーにフィルターを作成し、行を正しくフィルター処理していますが、列のサブセットを希望の順序で選択する方法がわかりません。ソーステーブルは列A〜Lであり、フィルターを適用した後、列C、I、H、Fをこの順序でクリップボードにコピーします。いくつかのコード（コピー部分を除く）が以下に含まれています。

Sub exportExample()
    Dim header As Range
    Dim srcCol As Range

    Set header = [A5:L5]

    header.AutoFilter
    header.AutoFilter 12, "Example", xlFilterValues

    'Copy out columns C, I, H and F of the resulting table in that order
End Sub

列をコピーする方法はわかりますが、希望する順序で列を取得する方法はわかりません。どんな助けでも大歓迎です！ありがとう！

4

2 に答える 2

2

これはあなたがしようとしていることですか？コードを理解するのに問題がないように、コードにコメントを付けました。

ロジック:

  1. データをフィルタリングする
  2. 一時シートを作成する
  3. フィルター処理されたデータを一時シートにコピー
  4. 不要な列を削除 (A,B,D,E,G,J,K,L)
  5. 関連する列 (C、F、H、I) を C、I、H、および F に再配置します。
  6. 最後に一時シートを削除します (IMP: コードの最後にあるメモを読んでください)

コード (試行錯誤)

Option Explicit

Sub Sample()
    Dim ws As Worksheet, wsTemp As Worksheet
    Dim rRange As Range, rngToCopy As Range
    Dim lRow As Long

    '~~> Change this to the relevant sheet
    Set ws = ThisWorkbook.Sheets("Sheet1")

    With ws
        '~~> Get the Last Row
        lRow = .Range("L" & .Rows.Count).End(xlUp).Row

        '~~> Set your range for autofilter
        Set rRange = .Range("A5:L" & lRow)

        '~~> Remove any filters
        .AutoFilterMode = False

        '~~> Filter, copy visible rows to temp sheet
        With rRange
            .AutoFilter Field:=12, Criteria1:="Example"

            '~~> This is required to get the visible range
            ws.Rows("1:4").EntireRow.Hidden = True

            Set rngToCopy = .SpecialCells(xlCellTypeVisible).EntireRow

            Set wsTemp = Sheets.Add

            rngToCopy.Copy wsTemp.Range("A1")

            '~~> Unhide the rows
            ws.Rows("1:4").EntireRow.Hidden = False
        End With

        '~~> Remove any filters
        .AutoFilterMode = False
    End With

    '~~> Re arrange columns in Temp sheet so that we get C, I, H and F
    With wsTemp
        .Range("A:B,D:E,G:G,J:L").Delete Shift:=xlToLeft
        .Columns("D:D").Cut
        .Columns("B:B").Insert Shift:=xlToRight
        .Columns("D:D").Cut
        .Columns("C:C").Insert Shift:=xlToRight

        lRow = .Range("A" & .Rows.Count).End(xlUp).Row

        Set rngToCopy = .Range("A1:D" & lRow)

        Debug.Print rngToCopy.Address

        '~~> Copy the range to clipboard
        rngToCopy.Copy
    End With

    'NOTE
    '
    '~~> Once you have copied the range to clipboard, do the necessary
    '~~> actions and then delete the temp sheet. Do not delete the
    '~~> sheet before that. An alternative would be to use the APIs
    '~~> to place the range in the clipboard so you can safely delete
    '~~> the sheet before performing any actions. This will not clear
    '~~> clear the range if the sheet is immediately deleted.
    '
    '

    Application.DisplayAlerts = False
    wsTemp.Delete
    Application.DisplayAlerts = True
End Sub

スクリーンショット

コード実行前の Sheet1

ここに画像の説明を入力

フィルター処理されたデータを含む一時シート

ここに画像の説明を入力

ファローアップ

境界線を削除するには、このコードを上記のコードに追加できます

With rngToCopy
    .Borders(xlDiagonalDown).LineStyle = xlNone
    .Borders(xlDiagonalUp).LineStyle = xlNone
    .Borders(xlEdgeLeft).LineStyle = xlNone
    .Borders(xlEdgeTop).LineStyle = xlNone
    .Borders(xlEdgeBottom).LineStyle = xlNone
    .Borders(xlEdgeRight).LineStyle = xlNone
    .Borders(xlInsideVertical).LineStyle = xlNone
    .Borders(xlInsideHorizontal).LineStyle = xlNone
end with

上記のコードを行の後に入れますDebug.Print rngToCopy.Address

于 2012-09-06T16:32:25.547 に答える
0

範囲を参照するオブジェクトはセルを順番に並べる必要があるため、列を個別にコピーする必要があります。

このようなものが動作するはずです:

activeworkbook.Sheets(1).Columns("C:C").copy activeworkbook.Sheets(2).Columns("A:A")
activeworkbook.Sheets(1).Columns("I:I").copy activeworkbook.Sheets(2).Columns("B:B")
activeworkbook.Sheets(1).Columns("H:H").copy activeworkbook.Sheets(2).Columns("C:C")
activeworkbook.Sheets(1).Columns("F:F").copy activeworkbook.Sheets(2).Columns("D:D")

次に、次のことができるはずです。

activeworkbook.Sheets(2).Columns("A:D").copy

クリップボードに入れる

于 2012-09-06T16:36:51.053 に答える