在VBA中过滤后减去集合

Question

我想从彼此中减去 2 个范围（组）。被减数（要减去的范围）包含减数（要减去的范围），这会创建一个正余数范围。请注意，被减数（基数）由过滤后的单元格组成，它们不一定相互连接。在介绍性示例之后，请参阅下面的更多内容。

例如假设被减数如下：

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) 可能必须从头开始创建。我尝试了另一个来源，但不幸的是它不适用于隐藏行。 [参考见Subtracting ranges in VBA (Excel)

我愿意接受任何关于如何实现这一目标的建议。我自己的一个想法是在过滤到临时表后复制可见单元格，在那里进行减法，然后将剩余部分复制回来。然而，这个解决方案的问题是，在任何过滤之前原始完整样本的行序列都会丢失（除了地址可以以某种方式保存），而且将东西复制到临时表中以便稍后删除它们总是有点不方便.你怎么看？

简短的目标：

1) 对原始完整样本应用过滤器以创建某个子样本 2）从子样本中减去一个范围，得到余数范围 3）停用过滤器以再次获得完整样本，使用原始顺序，但同时减去相应的范围（步骤2）

为什么不直接从完整样本中删除 (2) 中的范围？问题是这样做我不会得到正确的余数范围，这是我以后工作所需要的。想象一下，我有一整套 10,000 个单位、100 个单位的子集和要从子集中减去的 40 个单位的子集，这反过来又会导致 60 个单位的剩余范围。如果我从 10,000 个单位中减去 40 个单位，那将导致 9,960 个单位，这不是正确的余数范围。我希望这会使方法更加清晰。

Answer 1

使用数组来存储数据块：
子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...

结束子