Welcome to OStack Knowledge Sharing Community for programmer and developer-Open, Learning and Share
Welcome To Ask or Share your Answers For Others

Categories

0 votes
600 views
in Technique[技术] by (71.8m points)

excel - VBA for filtering columns

I have a big database-like sheet, first row contains headers. I would like a subset of rows of this table based on column values. Two issues:

1) VBA-wise I would like to loop through the columns, when the values for all necessary columns all match, copy the entire row into a new sheet.

2) The subset of rows is based on a list. I just read I can use Autofilter with an array. Is it possible to input this array from a column instead of manually entering it in the VBA code? The list I'm using consists of 200 different strings and will be updated periodically.

Where CritList is the list of strings. I still need to figure out how, but now I leave the office, so more tomorrow.

EDIT1 Thanks to @DougGlancy; the autofiltering works now. Here is his beautiful code (I only added the array-filter).

EDIT2 Included a more elaborate array-filter, where NameList is the list I would like to filter for. Now it all works!

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
See Question&Answers more detail:os

与恶龙缠斗过久,自身亦成为恶龙;凝视深渊过久,深渊将回以凝视…
Welcome To Ask or Share your Answers For Others

1 Answer

0 votes
by (71.8m points)

Here's a different approach. The heart of it was created by turning on the Macro Recorder and filtering the columns per your specifications. Then there's a bit of code to copy the results. It will run faster than looping through each row and column:

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

As a side note, your code has more loops and counter variables than necessary. You wouldn't need to loop through the columns, just through the rows. You'd then check the various cells of interest in that row, much like you did.


与恶龙缠斗过久,自身亦成为恶龙;凝视深渊过久,深渊将回以凝视…
Welcome to OStack Knowledge Sharing Community for programmer and developer-Open, Learning and Share
Click Here to Ask a Question

...