3

我想编写一个 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

有没有人有一个好主意来避免这种情况?

4

3 回答 3

2

您基本上需要跟踪您已经看到的内容。最简单的方法是使用Excel 提供的Union和方法以及.IntersectCurrentArrayRange

我只是输入了这个,所以我并没有声称它是详尽的或没有错误的,但它展示了基本思想:

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
于 2013-07-13T18:35:46.120 回答
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

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

另一个区别是我只查看包含使用公式的单元格SpecialCells,这比检查UsedRange.

于 2013-07-13T19:37:46.047 回答
0

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

如果大小不太重要(预计记录数低于 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.

于 2013-07-13T18:44:58.387 回答