我怎样才能通过一个工作表的所有公式和数组公式重复每个数组公式和很多次？
我想写一个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
有没有人有一个好主意，以避免这一点？
你基本上需要跟踪你已经看到了什么。 简单的方法是使用Excel提供的Union和Intersect方法，以及Range的CurrentArray属性。
我只是input了这个，所以我并没有声称它是详尽的或没有错误的，但它表明了基本思想：
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
下面的代码产生如下输出：
$B$7 -> =SUM(B3:B6) $B$10 -> =AVERAGE(B3:B6) $D$10:$D$13 -> =D5:D8 $F$14:$I$14 -> =TRANSPOSE(D5:D8)
我正在使用一个集合，但它也可以是一个string。
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更有效率。
我看到你的问题唯一可靠的解决scheme是交叉检查每一个新的公式，对已经考虑的，以确保没有重复。 根据信息的数量和速度的期望，你应该依靠不同的方法。
如果大小不是太重要（预计的logging数低于1000），你应该依赖数组，因为是最快的select，它的实现非常简单。 例：
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
如果预期的logging数量更大，我会依靠文件存储/检查。 依靠Excel（将检查过的单元格关联到一个新的范围并在其中寻找匹配）将会更容易但更慢（主要是在具有大量单元格的情况下）。 因此，一个可靠和快速的方法（虽然比前面提到的数组慢得多）将从alreadyAccounted读取正在创build的文件（我假设.txt文件）。