Требуется ошибка времени выполнения '424 объекта

Question

Я пытаюсь создать цикл, который будет проходить через каждый год данные о запасах и извлекать общий объем объема, который имел каждый запас за год, из файла с тремя листами. Каждый лист - это другой год.

Сначала я создал следующий код

Sub WorksheetLoop2()

 ' Declare Current as a worksheet object variable.
 Dim Current As Worksheet

 ' Loop through all of the worksheets in the active workbook.
  For Each Current In Worksheets
       ' Insert your code here.
       ' This line displays the worksheet name in a message box.
       MsgBox Current.Name
    Next
 End Sub

Код запускал окно сообщения со всеми тремя годами

Поскольку я хочу создать сценарий, который будет циклически проходить по каждому году данных о запасах и извлекать общий объем объема, который имел каждый запас за год, был создан следующий код:

Sub WorksheetLoop2()
  ' Declare Current as a worksheet object variable.
    Dim Current As Worksheet

    ' Loop through all of the worksheets in the active workbook.
    For Each Current In Worksheets

    Dim varRowCount As Integer
    'varRowCount = 0
    Dim key As Variant
    Dim TotalVolume As Double
    Dim lastrow As Integer

    Dim i As Single
    Dim tickers As Object                 'scripting.dictionery
    Set tickers = CreateObject("Scripting.Dictionary")  'make dictinery object

    Current.Activate
       'Current.Select           
       ' Insert your code here.
       ' This line displays the worksheet name in a message box.
       'MsgBox Current.Name

    lastrow = ws.Cells(Rows.Count, 1).End(xlUp).Row

       For i = 2 To lastrow
       key = Current.Rows(i).Cells(2, 1)

       If Not tickers.exists(key) Then
           ' The Key does not exists we need to add to the dictionary collection
           TotalVolume = Current.Rows(i).Cells(2, 7)
           tickers.Add key, TotalVolume
       Else
         ' Key exist so we need update previous value
         TotalVolume = tickers(key) ' First get the value
         ' Update the values
         TotalVolume = TotalVolume + Current.Rows(i).Cells(2, 7)
         ' Finally update the collection value
         tickers.Item(key) = TotalVolume
       End If
       'MsgBox (Current.Rows(i).Cells(2, 1))

       Next i           
    Next

    'MsgBox (tickers.Item("A"))

    'For Each key In tickers.Keys
     'MsgBox ("Ticker:" & key & " TotalVolume:" & tickers(key))
    'Next key
    MsgBox (tickers("A"))
 End Sub

однако я получаю сообщение об ошибке

Ошибка времени выполнения 'Требуется объект 424

Когда я пытаюсь его отладить, выделяется следующее lastrow = ws.Cells(Rows.Count, 1).End(xlUp).Row

Что не так с моим кодом?

Answer 1

Вы должны полностью квалифицировать свою ссылку Rows следующим образом:

lastrow = ws.Cells(ws.Rows.Count, 1).End(xlUp).Row

В противном случае она использует ActiveSheet