Как я могу фильтровать и копировать данные в Excel?

Question

У меня много данных на листе Excel. Для расчетов я хотел бы ограничить эти данные только соответствующими данными. То есть: отфильтруйте данные и поместите подмножество в другой лист.
Соответствующие данные - это данные, которые попадают в пределы заданного минимального и максимального значения.

Например:
Предположим, я хочу отфильтровать столбец A для значений от 1 до 2 и столбец B для значений от 0 до 1. Результат должен выглядеть следующим образом.

  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

Есть ли простое решение для этого?
Тот факт, что я не фильтрую точные совпадения, по-видимому, усложняет проблему.

Заранее спасибо!

Answer 1

У меня есть быстрая процедура VBA, которая будет делать то, что вы хотите ...

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

CriteriaRange - это просто двухстрочный диапазон, дающий минимальные и максимальные значения для каждого столбца.

Я уверен, что это не самый элегантный и эффективный способ, но я использовал его как быстрое решениетак как мне нужно было сделать это один или два раза.

Если вам неудобно использовать код VBA, дайте мне знать, и я уверен, что смогу преобразовать его в функцию рабочего листа для вас (это также даст дополнительное преимущество обновления, если вы измените критерии ...)

Simon