Объект или переменная не установлена

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.Цель состоит в том, чтобы запустить макрос в электронной таблице Excel с именем master на рабочем листе с именем master, который открывает другие рабочие книги 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 - поскольку параметр Key является String, Range.[_Default] неявно приведен к одному, и у вас есть строковый ключ.Однако фактический элемент словаря для этого ключа не такой удачный.

Вот MCVE:

Public Sub Test()
    Dim d As Dictionary
    Set d = New Dictionary
    d.Add "A1", Cells(1, 1)
    Debug.Print IsObject(d("A1"))
End Sub

Эта процедура выводит True на панель отладки (Ctrl + G):то, что вы храните в своем словаре, это не набор строковых значений, а набор Range ссылок на объекты.

Поэтому, когда вы сделаете это:

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

Вы можететакже объявили myInsert As Range, потому что это единица.

Здесь все становится интереснее:

MsgBox (myInsert)

Не обращайте внимания на лишние скобки, которые принудительно оценивают элемент объекта по умолчанию и передают егоByVal в функцию MsgBox - здесь вы неявно преобразуете Range.[_Default] в String.Это, вероятно, работает.

Так почему же тогда это не получается?

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

Обычно это не так.VBA с радостью сделает это:

wkSheet.ListObjects(1).DataBodyRange.Cells(2, 1).[_Default] = reportDict.Item(Key).[_Default]

И запишет значение в DataBodyRange из ListObject в указанном месте.

Я думаю, что это всего лишь красная сельдь,Напишите явный код: если вы хотите сохранить Value ячейки, сохраните Value ячейки .Если вы хотите назначить Value ячейки, назначить Value ячейки .

Я не могу повторить ошибку 91 с этой настройкой.

Это, однако:

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

... также принудительно оценивает элемент по умолчанию ListObject, поэтому DeleteTableRows не получает ListObject, он получает String, который содержит имя объекта, который вы только что разыменовали ... но DeleteTableRows принимает параметр ListObject, так что код не может даже получить чтобы запустить FillTableRows - он должен взорваться с несоответствием типов , прежде чем DeleteTableRows даже попадет в систему.На самом деле это ошибка времени компиляции .

Так что это довольно длинный ответ, который не доходит до причины ошибки 91 в этой конкретной строке (я не могу воспроизвестиэто), но выделяет метрическую тонну серьезных проблем с вашим кодом, которые очень вероятно связаны с этой ошибкой, которую вы получаете.Надеюсь, это поможет.

Answer 2

Вам нужно перебрать коллекцию ключей словаря.

dim k as variant, myInsert As Variant

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