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方法，以及CurrentArray的{{1}}属性。

我只是键入了这个，所以我并没有声称它是详尽的或没有错误的，但它证明了基本的想法：

Range

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文件）。

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

3 个答案: