vba - 如何浏览工作表的所有公式和数组公式而不多次重复每个数组公式？

Question

我想编写一个 VBA 函数，它输出工作表的所有单个公式和数组公式的列表。我想要一个范围的数组公式仅打印一次。

如果我按如下方式遍历所有 UsedRange.Cells ，它将多次打印每个数组公式，因为它覆盖了多个单元格，这不是我想要的。

 For Each Cell In CurrentSheet.UsedRange.Cells
     If Cell.HasArray Then
        St = Range(" & Cell.CurrentArray.Address & ").FormulaArray = " _
                & Chr(34) & Cell.Formula & Chr(34)
     ElseIf Cell.HasFormula Then
        St = Range(" & Cell.Address & ").FormulaR1C1 = " _
                & Chr(34) & Cell.Formula & Chr(34)
     End If
     Print #1, St
 Next

有人有避免这种情况的好主意吗？

Answer 1

您基本上需要跟踪您已经看到的内容。最简单的方法是使用 Excel 提供的 Union 和 Intersect 方法，以及 Range< 的 CurrentArray 属性。/.

我刚刚输入了此内容，因此我并不是说它是详尽的或没有错误的，但它演示了基本思想:

Public Sub debugPrintFormulas()
    Dim checked As Range

    Dim c As Range
    For Each c In Application.ActiveSheet.UsedRange
        If Not alreadyChecked_(checked, c) Then
            If c.HasArray Then
                Debug.Print c.CurrentArray.Address, c.FormulaArray

                Set checked = accumCheckedCells_(checked, c.CurrentArray)
            ElseIf c.HasFormula Then
                Debug.Print c.Address, c.Formula

                Set checked = accumCheckedCells_(checked, c)
            End If
        End If
    Next c
End Sub

Private Function alreadyChecked_(checked As Range, toCheck As Range) As Boolean
    If checked Is Nothing Then
        alreadyChecked_ = False
    Else
        alreadyChecked_ = Not (Application.Intersect(checked, toCheck) Is Nothing)
    End If
End Function

Private Function accumCheckedCells_(checked As Range, toCheck As Range) As Range
    If checked Is Nothing Then
        Set accumCheckedCells_ = toCheck
    Else
        Set accumCheckedCells_ = Application.Union(checked, toCheck)
    End If
End Function