搜索错误，填充数组并呈现类似于视图的枢轴

Question

我的代码可以在工作表中搜索错误并将单元格地址和错误放在单独的工作表中。

Set RErrors = Nothing
On Error Resume Next
Set RErrors = Sheets("Sheet1").ListObjects("Table").Range.SpecialCells(xlCellTypeFormulas, 16)
On Error GoTo 0
Counter = 0
If Not RErrors Is Nothing Then
    Workbooks(Different_Workbook).Sheets(Different_Sheet).Activate
    For Each x In RErrors
        ActiveSheet.Range("A1").Offset(Counter, 0).Formula = x.Address
        ActiveSheet.Range("B1").Offset(Counter, 0) = x
        x.ClearContents
        Counter = Counter + 1
    Next x
End If

代码正在运行，但我打算将所有错误单元格地址和相应的错误填充到一个二维数组中，并为每种错误类型和单元格数量呈现一个透视视图。

我面临两个问题--

1. 当我不知道错误的数量时如何初始化数组（并且没有 Dim，我无法填充）？也许这意味着运行一个循环首先找到所有错误然后得到错误的总和然后 Dim 然后再次循环来填充错误数组，所以两个循环一件事？

2. 如何操作错误（和位置）填充数组以获得显示每种错误类型有多少个单元格的结果（如枢轴）？

Answer 1

对于数组的初始化，你不知道其中的项目数，使用Redim。 Redim MS Documentation.

但是，阅读问题的目的似乎是对错误数量进行某种总结。让我们考虑以下错误：

来自以下代码：

Sub PopulateErrors()

    Dim myCell As Range
    With Worksheets(1)
        For Each myCell In .Range("A1:A5")
            myCell.Formula = "=0 / 0"
        Next myCell

        For Each myCell In .Range("B1:B2")
            myCell.Formula = "=nonexistingformula()"
        Next myCell

        For Each myCell In .Range("C1:C3")
            myCell.Formula = "=4+""ky"""
        Next myCell
    End With

End Sub

这些可以用dictionary object 总结如下：

Sub ErrorDataSummary()

    Dim myCell As Range
    Dim myDict As Object

    Set myDict = CreateObject("Scripting.Dictionary")


    For Each myCell In Worksheets(1).Range("A1:C5")
        If IsError(myCell) Then
            If myDict.exists(myCell.Text) Then
                myDict(myCell.Text) = myDict(myCell.Text) + 1
            Else
                myDict(myCell.Text) = 1
            End If
        End If
    Next myCell

    Dim myKey As Variant
    For Each myKey In myDict.keys
        Debug.Print myKey; myDict(myKey)
    Next

End Sub

运行代码，得到如下总结：