构建 Excel function：取消合并、计算、重新合并。 问题：Function 开始运行递归未完成

Question

我的主要目标是能够在一列中自动过滤合并的单元格。
在下图中，当我从自动筛选菜单中删除“6”时，我希望第 7-9 行消失。
但正如我所想的，我需要在所有单元格“L7：L9”中保存值“6”，以便 Excel 这样做。

数字 6 是通过以下 function 我放在“L7”中的“Num1”和“Num2”（2 * 3）相加计算得出的：

Function Exposure(arg1 As Range, arg2 As Range) As Variant
Application.EnableEvents = False
Application.Calculation = xlManual

If Application.ThisCell.Offset(, -1).Value <> "-" And Application.ThisCell.Offset(, -2).Value <> "-" Then
       Exposure = Left(Application.ThisCell.Offset(, -1).Value, 1) * Left(Application.ThisCell.Offset(, -2).Value, 1)
End If
If Exposure = 0 Then Exposure = "-"

Application.Calculation = xlAutomatic
Application.EnableEvents = True
End Function

我将以下公式放入合并的单元格“L7”中： =Exposure(K7;J7) 。 然后公式被拖下来。
“Num1”和“Num2”由验证字段、下拉菜单控制。

我的计划是在计算曝光变量后取消合并，在剩余的行中填充相同的值，然后重新合并相同的区域。 所以我写了这个独立的子：

Sub WorkingSub(rng As Range)
'Set rng = ActiveCell.MergeArea
rng.UnMerge
For i = 2 To rng.Cells.Count
    rng.Cells(i).Value = rng.Cells(1).Value 'This line triggers recursion
Next i
rng.Offset(rng.Cells.Count).Copy 'Copies format from below
rng.PasteSpecial Paste:=xlPasteFormats 'Paste that keeps the values even after merging
End Sub

它可以自行工作，但在上面的 function 内部调用时不能。 设置第一个值后，function 触发“某事”，调试显示 function 重新开始，跳过rng.PasteSpecial Paste:=xlPasteFormats代码。

所以我对你们的问题是我如何编写我的函数来停止“递归”并让我在 function 调用期间取消合并？

还是我以错误的方式攻击这个？ 你会怎么做？

由于很多原因，我被合并单元格困住了，这只是这个电子表格中许多的一部分。

Answer 1

一个有趣的问题。 您可以通过捕获计算中的更改然后处理表的行以获得可见性来捕获过滤器事件。 我对初始表范围分配做了一些假设，可能需要进行一些更改。

If Not VisRange Is Nothing Then实际上是多余的，因为如果分配了一个空范围，前一行将抛出一个合适的，但我只是保留它。为了绕过 null 范围，将 header 范围保留在初始 MergedTableRange所以总会有一行可见

在同一工作表或“虚拟”工作表中的某个单元格内

=SUBTOTAL(103,Sheet1!A3:H10) 'Or other table range

在工作表模块代码中

Private Sub Worksheet_Calculate()
    Dim ws As Worksheet: Set ws = Worksheets("Sheet1")
    Dim MergedTableRange As Range: Set MergedTableRange = ws.Range("A2").CurrentRegion
    
    Dim Cell As Range
    Dim VisRange As Range: Set VisRange = MergedTableRange.SpecialCells(xlCellTypeVisible)
    If Not VisRange Is Nothing Then
        For Each Cell In VisRange
            If Not Application.Intersect(Cell.MergeArea, VisRange).Address = Cell.MergeArea.Address Then
                Cell.Rows.Hidden = True
            End If
        Next Cell
    End If
End Sub

Answer 2

我想出了一个不同的方法。 也许我缺少一个缺点。 但是我的几次测试运行都成功了。

我已经有一个名为“模板”的隐藏表，其中存储了每个新“#”的格式。 因此，每当用户想要插入新行时，模板都会准备好合并和未合并的单元格，并且插入是通过复制粘贴完成的。

在同一张表中，我在第 2 列中合并了 2 行，在第 3 列中合并了 3 个单元格，依此类推：

这样，我可以在用正确的值填充未合并的行后复制正确数量的合并行进行粘贴。

我得出的结论是，我可以在“Num1”和“Num2”列上捕获 Worksheet_change，而不是捕获和取消自动过滤器调用。

所以我补充说：

Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Target.Worksheet.Range("J:J")) Is Nothing Then
        Call UnMergeMerge(Cells(Target.Row, "L").MergeArea)
End If
If Not Intersect(Target, Target.Worksheet.Range("K:K")) Is Nothing Then
        Call UnMergeMerge(Cells(Target.Row, "L").MergeArea)
End If
End Sub

而 UnMergeMerge 子最终成为：

Sub UnMergeMerge(rng As Range)
Application.EnableEvents = False
Application.ScreenUpdating = False
rng.UnMerge
For i = 2 To rng.Cells.Count
    rng.Cells(i).Value = rng.Cells(1).Value
Next i
With Sheets("Template")
    .Range(.Cells(8, rng.Cells.Count), .Cells(8 + rng.Cells.Count, rng.Cells.Count)).Copy
End With
rng.PasteSpecial Paste:=xlPasteFormats
Application.EnableEvents = True
Application.ScreenUpdating = True
End Sub

仍然不确定这是最快和最好的方法...你们仍然相信捕获、撤消和运行不同的自动过滤器会更有效吗？