如何在不重复每个数组公式多次的情况下浏览工作表的所有公式和数组公式？

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

Answer 2

以下代码产生如下输出：

$B$7 -> =SUM(B3:B6)
$B$10 -> =AVERAGE(B3:B6)
$D$10:$D$13 -> =D5:D8
$F$14:$I$14 -> =TRANSPOSE(D5:D8)

我正在使用一个集合，但它也可以是一个字符串。

Sub GetFormulas()
    Dim ws As Worksheet
    Dim coll As New Collection
    Dim rngFormulas As Range
    Dim rng As Range
    Dim iter As Variant

    Set ws = ActiveSheet
    On Error Resume Next
    Set rngFormulas = ws.Range("A1").SpecialCells(xlCellTypeFormulas)
    If rngFormulas Is Nothing Then Exit Sub 'no formulas
    For Each rng In rngFormulas
        If rng.HasArray Then
            If rng.CurrentArray.Range("A1").Address = rng.Address Then
                coll.Add rng.CurrentArray.Address & " -> " & _
                    rng.Formula, rng.CurrentArray.Address
            End If
        Else
            coll.Add rng.Address & " -> " & _
                rng.Formula, rng.Address
        End If
    Next rng
    For Each iter In coll
        Debug.Print iter
        'or Print #1, iter
    Next iter
    On Error GoTo 0     'turn on error handling
End Sub

主要区别在于，如果正在检查的当前单元格是 CurrentArray 中的单元格 A1，我只会将数组公式写入集合；也就是说，只有当它是数组范围的第一个单元格时。

另一个区别是，我只查看包含使用 SpecialCells 的公式的单元格，这将比检查 UsedRange 更有效。

Answer 3

对于您的问题，我看到的唯一可靠的解决方案是将每个新公式与已经考虑过的公式进行交叉检查，以确保没有重复。根据信息量和速度预期，您应该采用不同的方法。

如果大小不是很重要（预计记录数低于 1000），您应该依赖数组，因为它是最快的选择，而且它的实现非常简单。示例：

Dim stored(1000) As String
Dim storedCount As Integer

Sub Inspect()

 Open "temp.txt" For Output As 1
 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
     If(Not alreadyAccounted(St) And storedCount <= 1000) Then
        storedCount = storedCount + 1
        stored(storedCount) = St
        Print #1, St
     End If
 Next
 Close 1
End Sub

Function alreadyAccounted(curString As String) As Boolean
    Dim count As Integer: count = 0

    Do While (count < storedCount)
        count = count + 1
        If (LCase(curString) = LCase(stored(count))) Then
            alreadyAccounted = True
            Exit Function
        End If
    Loop
End Function

如果预期的记录数要大得多，我将依赖文件存储/检查。依靠 Excel（将检查的单元格与新范围相关联并在其中查找匹配项）会更容易但速度较慢（主要是在单元格数量很大的情况下）。因此，一种可靠且足够快速的方法（尽管比上述数组慢得多）是从alreadyAccounted 读取您正在创建的文件（我猜是 .txt 文件）。