Вычесть наборы после фильтрации в VBA

Question

Я хотел бы вычесть 2 диапазона (наборы) друг от друга. Minuend (диапазон, из которого нужно вычесть) содержит вычитаемое (диапазон, который нужно вычесть), который создает положительный диапазон остатка. Обратите внимание, что minuend (база) состоит из отфильтрованных ячеек, которые не обязательно связаны друг с другом. Подробнее об этом ниже, после вступительного примера.

Например, предположим, что minuend is is следующим образом:

x1  x2  x3
A   A   A
A   A   B
A   A   C

Вычитаемое выглядит следующим образом, где - ничего не означает и просто используется для иллюстрации позиционирования:

x1  x2  x3
-   -   A
-   -   -
-   -   C

Тогда остаток должен быть следующим:

x1  x2  x3
A   A   -
A   A   B
A   A   -

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

X1  X2  X3
12  13  B
12  15  C
12  15  D
12  15  E
12  15  F
13  15  G
13  15  H
13  13  I
13  15  J
13  15  K
13  15  L
13  15  M
13  13  N
13  15  O
13  15  P
13  15  Q
13  15  R
13  14  S

Сначала я фильтрую второй столбец для отображения только "13". Это дает:

X1  X2  X3
12  13  B
13  13  I
13  13  N

Тогда скажем, я хочу вычесть Cells(2,3) который B а также Cells(14,3) который N из приведенного выше диапазона или показано так же, как и раньше:

X1  X2  X3
-   -   B
-   -   -
-   -   N

Тогда результат должен быть:

X1  X2  X3
12  13  -
13  13  I
13  13  -

Код для достижения этого (незаконченный):

Sub TestingStuff()

Dim y As Integer
Dim x1 As Range, x2 As Range, xs As Range

Dim ws As Worksheet: Set ws = ActiveWorkbook.ActiveSheet

ws.AutoFilterMode = False
Dim rng As Range: Set rng = ws.UsedRange
rng.AutoFilter
rng.AutoFilter Field:=2, Criteria1:="13"

Dim myR As Range: Set myR = ws.UsedRange

Set x1 = myR.Offset(1, 0).Resize(myR.Rows.count - 1).SpecialCells(xlCellTypeVisible)
Set x2 = Union(ws.Cells(2, 3), ws.Cells(14, 3))
' Set xs = SubtractRanges(x1, x2)

End Sub

Код для вычитания двух рядов друг от друга SubtractRanges(x1, x2) вероятно, должно быть создано с нуля. Я попробовал другой источник, но, к сожалению, он не работает со скрытыми строками. [Для справки см. Вычитание диапазонов в VBA (Excel)

Я открыт для любых предложений, как этого добиться. Одной из моих идей было скопировать видимые ячейки после фильтрации на временный лист, выполнить там вычитание, а затем скопировать остаток обратно. Однако проблема с этим решением заключается в том, что последовательность строк исходного полного образца до того, как будет потеряна любая фильтрация (за исключением того, что адреса могут быть каким-либо образом сохранены), и, кроме того, всегда немного неудобно копировать содержимое во временные листы, чтобы потом удалить их., Как вы думаете?

Цели вкратце:

1) применить фильтр к исходной полной выборке, чтобы создать определенную подвыборку 2) вычесть диапазон из подвыборки, чтобы получить остаточный диапазон 3) деактивировать фильтр, чтобы снова получить полную выборку с исходным порядком, но в то же время вычитается из соответствующего диапазона (шаг 2)

Почему бы просто не удалить диапазон в (2) из ​​полной выборки? Проблема в том, что при этом я не получу правильный диапазон остатка, который мне нужен для дальнейшей работы. Представьте, что у меня есть полный набор из 10000 единиц, подмножество из 100 единиц и подмножество из 40 единиц, которые нужно вычесть из подмножества, что, в свою очередь, приведет к 60 единицам оставшегося диапазона. Если бы вместо этого я вычел 40 единиц из 10000 единиц, это привело бы к 9 960 единицам, что не является правильным диапазоном остатка. Я надеюсь, что это делает подход более ясным.

Answer 1

Использование массива для хранения блока данных:
Sub TestingStuff ()

Dim y As Integer
Dim x1 As Range, x2 As Range, xs As Range

Dim ws As Worksheet: Set ws = ActiveWorkbook.ActiveSheet

ws.AutoFilterMode = False
Dim rng As Range: Set rng = Range("A1").CurrentRegion

rng.AutoFilter Field:=2, Criteria1:="13"

Dim arr() As Variant
ReDim arr(0 To 2, 0 To rng.Rows.Count)

Set x2 = Union(ws.Cells(2, 3), ws.Cells(14, 3))

j = 0

'Build array
For i = 1 To rng.Rows.Count
    If rng.Rows(i).Hidden = False Then
        arr(0, j) = rng(i, 1)
        arr(1, j) = rng(i, 2)
        arr(2, j) = rng(i, 3)
        For Each cell In x2
            If cell.Row = i Then
                arr(cell.Column - 1, j) = ""
            End If
        Next cell

        j = j + 1
    End If
Next i
ReDim Preserve arr(0 To 2, 0 To j)

Range("E25").CurrentRegion.Clear
Set xs = Range("E25:G" & 25 + j)
xs = Application.Transpose(arr)
'Do whatever you wish with the array
'such as print to another range etc, transpose it etc
'If you wanted it lined up with the original table, you
'wouldnt need to buid an array necessarily - I dont know where you want the output...

End Sub