Question

Option Explicit
Public Sub consolidateList()

    DeleteTableRows (ThisWorkbook.Worksheets("Master").ListObjects("MasterSheet"))

    FillTableRows

End Sub

Private Sub FillTableRows()

    'set up worksheet objects
    Dim wkSheet As Worksheet
    Dim wkBook As Workbook
    Dim wkBookPath As String
    Set wkBook = ThisWorkbook
    wkBookPath = wkBook.Path


    Set wkSheet = wkBook.Worksheets("Master")

    'set up file system objects
    Dim oFile As Object
    Dim oFSO As Object
    Dim oFolder As Object
    Dim oFiles As Object

    Set oFSO = CreateObject("Scripting.FileSystemObject")
    Set oFolder = oFSO.GetFolder(wkBookPath)
    Set oFiles = oFolder.Files


    'set up loop

    Dim checkBook As Excel.Workbook
    Dim reportDict As Dictionary

    Application.ScreenUpdating = False



    'initial coordinates
    Dim startRow As Long
    Dim startColumn As Long


    startColumn = 3

    Dim i As Long 'tracks within the row of the sheet where information is being pulled from
    Dim k As Long 'tracks the row where data is output on
    Dim j As Long 'tracks within the row of the sheet where the data is output on

    Dim Key As Variant

    j = 1
    k = wkSheet.Range("a65536").End(xlUp).Row + 1


    Dim l As Long


    'look t Set checkBook = Workbooks.Open(oFile.Path)hrough folder and then save it to temp memory
    On Error GoTo debuger

        For Each oFile In oFiles
            startRow = 8


            'is it not the master sheet? check for duplicate entries
            'oFile.name is the name of the file being scanned


                'is it an excel file?
                If Mid(oFile.Name, Len(oFile.Name) - 3, 4) = ".xls" Or Mid(oFile.Name, Len(oFile.Name) - 3, 4) = ".xlsx" Then

                    Set checkBook = Workbooks.Open(oFile.Path)

                    For l = startRow To 600

                        If Not (IsEmpty(Cells(startRow, startColumn))) Then


                            'if it is, time do some calculations

                            Set reportDict = New Dictionary

                            'add items of the payment

                            For i = 0 To 33
                                If Not IsEmpty(Cells(startRow, startColumn + i)) Then
                                    reportDict.Add Cells(4, startColumn + i), Cells(startRow, startColumn + i)
                                End If
                            Next i


                            For i = startRow To 0 Step -1

                                    If Not IsEmpty(Cells(i, startColumn - 1)) Then
                                         reportDict.Add "Consumer Name", Cells(i, startColumn - 1)
                                         Exit For
                                    End If
                            Next i


                                'key is added
                                For Each Key In reportDict
                                    'wkSheet.Cells(k, j) = reportDict.Item(Key)


                                    Dim myInsert As Variant
                                    Set myInsert = reportDict.Item(Key)

                                    MsgBox (myInsert)

                                    wkSheet.ListObjects(1).DataBodyRange(2, 1) = reportDict.Item(Key)
                                    j = j + 1

                                Next Key
                                    wkSheet.Cells(k, j) = wkSheet.Cells(k, 9) / 4
                                    wkSheet.Cells(k, j + 1) = oFile.Name
    '
                            k = k + 1

                         '   Set reportDict = Nothing
                            j = 1
                        Else
                            l = l + 1

                        End If
                        startRow = startRow + 1

                   Next l

                   checkBook.Close
                End If
        '        Exit For

        Next oFile


Exit Sub
debuger:
    MsgBox ("Error on: " & Err.Source & " in file " & oFile.Name & ", error is " & Err.Description)



End Sub


Sub DeleteTableRows(ByRef Table As ListObject)
    On Error Resume Next
    '~~> Clear Header Row `IF` it exists
    Table.DataBodyRange.ClearContents
    '~~> Delete all the other rows `IF `they exist
    Table.DataBodyRange.Offset(1, 0).Resize(Table.DataBodyRange.Rows.count - 1, _
    Table.DataBodyRange.Columns.count).Rows.Delete
    On Error GoTo 0
End Sub

问候。上面的代码将保存在excel电子表格中的数据文件夹合并为一个主excel电子表格。目的是在名为master的工作表上的名为master的Excel Spreadsheet上运行宏，该宏在文件夹中打开其他excel工作簿，获取信息，并将其放入工作表“ master”中的表中。在这之后，很容易看到信息。因此，记录不是保存在数百个工作表上，而是保存在一个工作表上。

该代码使用词典（reportDict）临时存储各个工作簿所需的信息。然后的目标是获取该信息并将其放在主表的底部行，然后显然在成功放置数据之后或尝试放置数据之前添加新行。

代码在以下行失败：

wkSheet.ListObjects(1).DataBodyRange(2, 1) = reportDict.Item(Key)

失败描述是“对象或未设置变量”，因此问题出在reportDict.Item（Key）上。我的猜测是，VBA某种程度上无法将字典项识别为稳定的，但是我不知道如何纠正这一问题。最终目标是拥有可以做到的代码：

for each key in reportDict
  - place the item which is mapped to the key at a unique row,column in the master table
  - expand the table to accomodate necessary data
next key

Answer 1

隐含的默认成员调用使您的代码无处不在。

reportDict.Add Cells(4, startColumn + i), Cells(startRow, startColumn + i)

这隐式地从当前Range.[_Default]的任何工作表中访问ActiveSheet（您是说要成为wkSheet.Cells吗？），以获取Key-自{{ 1}}参数是Key，String被隐式强制为1，并且您有一个字符串键。但是，该键上实际的字典项并不那么幸运。

这是MCVE：

Range.[_Default]

此过程将Public Sub Test() Dim d As Dictionary Set d = New Dictionary d.Add "A1", Cells(1, 1) Debug.Print IsObject(d("A1")) End Sub打印到调试窗格（Ctrl + G）：您在字典中存储的不是一堆字符串值，而是一堆True对象引用。

因此，当您这样做时：

Range

您最好也声明Dim myInsert As Variant Set myInsert = reportDict.Item(Key)，因为它是一个。

这是有趣的地方：

myInsert As Range

不要忘记强制评估对象的默认成员并将其MsgBox (myInsert)传递给ByVal函数的多余括号-在这里，您将MsgBox隐式转换为Range.[_Default] 。那可能有效。

那为什么会失败？

String

通常不会。 VBA会很乐意这样做：

wkSheet.ListObjects(1).DataBodyRange(2, 1) = reportDict.Item(Key)

然后将值写入wkSheet.ListObjects(1).DataBodyRange.Cells(2, 1).[_Default] = reportDict.Item(Key).[_Default]的{{1}}中的指定位置。

我认为那只是红鲱鱼。编写明确的代码：如果要存储单元格的DataBodyRange，请存储单元格的ListObject 。如果您要分配单元格的Value，请分配单元格的Value 。

我无法使用此设置复制错误91。

但是，这是

Value

... 也是强制评估Value的默认成员-因此DeleteTableRows (ThisWorkbook.Worksheets("Master").ListObjects("MasterSheet"))没有收到ListObject，它得到了{ {1}}包含刚刚取消引用的对象的名称...但是DeleteTableRows带有一个ListObject参数，因此代码甚至都无法 get 才能运行String-在DeleteTableRows进入之前，它必须因类型不匹配而崩溃。实际上，是编译时错误。

因此，这是一个相当长的答案，无法理解该特定行上错误91的原因（我无法重现），但突出显示了您的代码中相当多的严重问题，它们非常非常可能 与您收到的此错误有关。希望对您有所帮助。

Answer 2

您需要遍历字典的Keys集合。

dim k as variant, myInsert As Variant

for each k in reportDict.keys
    debug.print reportDict.Item(k)
next k

对象或未设置变量

2 个答案: