Question

I have a lot of data in an excel worksheet. For calculations, I would like to restrict this data to the relevant data only. That is: filter the data and put the subset in another worksheet.
Relevant data is data that falls within a given minimum and maximum value.

For example:
Suppose I want to filter column A for values between 1 and 2, and column B for values between 0 and 1. Result should become like this.

  A B C = Data
1 0 0 0
2 1 1 0
3 2 0 3
4 2 2 1

  A B C = Result
1 1 1 0
2 2 0 3

Is there an easy solution for this?
The fact that I don t filter on exact matches apparently makes the problem more difficult.

提前感谢!

Answer 1

我走过快的VA程序,只有你想要做的事情。

Private Sub MultiFilter(DataRange As Range, CriteriaRange As Range, OutputRangeTL As Range)
    Dim intRowCounter As Integer
    Dim intColCounter As Integer
    Dim varCurrentValue As Variant
    Dim blnCriteriaError As Boolean
    Dim rngOutputCurrent As Range

    If CriteriaRange.Columns.Count <> DataRange.Columns.Count Then
        Err.Raise Number:=513, Description:="CriteriaRange and DataRange must have same column count"
    End If
    If CriteriaRange.Rows.Count <> 2 Then
        Err.Raise Number:=513, Description:="CriteriaRange must be of 2 rows"
    End If

    Set rngOutputCurrent = OutputRangeTL.Resize(1, DataRange.Columns.Count)

    For intRowCounter = 1 To DataRange.Rows.Count
        For intColCounter = 1 To DataRange.Columns.Count
            varCurrentValue = DataRange.Cells(intRowCounter, intColCounter).Value
            If Not (varCurrentValue >= CriteriaRange.Cells(1, intColCounter) _
            And varCurrentValue <= CriteriaRange.Cells(2, intColCounter)) Then
                  #i.e. criteria doesn t match
                blnCriteriaError = True
                Exit For
            End If
        Next intColCounter
        If Not blnCriteriaError Then
              #i.e. matched all criteria
            rngOutputCurrent.Value = DataRange.Resize(1).Offset(intRowCounter - 1).Value
            Set rngOutputCurrent = rngOutputCurrent.Offset(1)
        End If
        blnCriteriaError = False
    Next intRowCounter
End Sub

使用:

DataRange:
0 0 0
1 1 0
2 0 3
2 2 1

CriteriaRange:
1 0 0
2 1 10

然后:

Public Sub DoTheFilter()
    MultiFilter Range("MyDataRange"), Range("MyCriteriaRange"), Range("MyOutputRangeTopLeft")
End Sub

标准宽度只是两个行距,每个栏的最低和最高值。

这是我确信最有效的方式,但我把它当作一个快速的固定点,因为我需要一两次这样做。

如果你不喜欢使用传统做法守则,那么让我知道,我相信我能够把它变成你的工作单项功能(如果你改变标准,这也会有更新的附加优势......)

页: 1

友情链接