4

私は大きなデータベースのようなシートを持っています。最初の行にはヘッダーが含まれています。列の値に基づいて、このテーブルの行のサブセットが必要です。2つの問題：

1）VBAに関しては、列をループしたいと思います。必要なすべての列の値がすべて一致したら、行全体を新しいシートにコピーします。

2）行のサブセットはリストに基づいています。配列でオートフィルターを使用できることを読みました。この配列をVBAコードに手動で入力する代わりに、列から入力することは可能ですか？私が使用しているリストは200の異なる文字列で構成されており、定期的に更新されます。

ここで、CritListは文字列のリストです。私はまだその方法を理解する必要がありますが、今はオフィスを離れるので、もっと明日です。

EDIT1 @DougGlancyに感謝します。自動フィルタリングが機能するようになりました。これが彼の美しいコードです（私はarray-filterを追加しただけです）。

EDIT2より複雑な配列フィルターが含まれています。ここで、NameListはフィルター処理するリストです。今ではすべてうまくいきます！

Sub FilterAndCopy()
Dim LastRow As Long

Dim vName As Variant
Dim rngName As Range
Set rngName = Sheets("Sheet3").Range("NameList")

vName = rngName.Value

Sheets("Sheet2").UsedRange.Offset(0).ClearContents
With Worksheets("Sheet1")
    .Range("A:E").AutoFilter

    'Array filter from NameList
    .Range("A:J").AutoFilter Field:=3, Criteria1:=Application.Transpose(vName), _
                                Operator:=xlFilterValues

    .Range("A:E").AutoFilter field:=2, Criteria1:="=String1" _
                                  , Operator:=xlOr, Criteria2:="=string2"
    .Range("A:E").AutoFilter field:=3, Criteria1:=">0", _
    .Range("A:E").AutoFilter field:=5, Criteria1:="Number"

    LastRow = .Range("A" & .Rows.Count).End(xlUp).Row
    .Range("A1:A" & LastRow).SpecialCells(xlCellTypeVisible).EntireRow.Copy _
            Destination:=Sheets("Sheet2").Range("A1")

End With
End Sub
4

1 に答える 1

16

ここに別のアプローチがあります。その核心は、マクロ レコーダーをオンにして、仕様に従って列をフィルタリングすることによって作成されました。次に、結果をコピーするためのコードが少しあります。各行と列をループするよりも高速に実行されます。

Sub FilterAndCopy()
Dim LastRow As Long

Sheets("Sheet2").UsedRange.Offset(0).ClearContents
With Worksheets("Sheet1")
    .Range("$A:$E").AutoFilter
    .Range("$A:$E").AutoFilter field:=1, Criteria1:="#N/A"
    .Range("$A:$E").AutoFilter field:=2, Criteria1:="=String1", Operator:=xlOr, Criteria2:="=string2"
    .Range("$A:$E").AutoFilter field:=3, Criteria1:=">0"
    .Range("$A:$E").AutoFilter field:=5, Criteria1:="Number"
    LastRow = .Range("A" & .Rows.Count).End(xlUp).Row
    .Range("A1:A" & LastRow).SpecialCells(xlCellTypeVisible).EntireRow.Copy _
            Destination:=Sheets("Sheet2").Range("A1")
End With
End Sub

補足として、コードには必要以上のループとカウンター変数があります。行をループするだけで、列をループする必要はありません。次に、同じように、その行で目的のさまざまなセルを確認します。

于 2012-12-18T15:31:08.400 に答える