Runscript Error '9' Subscript вне диапазона

Question

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

Я получаю сообщение об ошибке времени выполнения, но не могу определить, какое значение ищет код, который продолжает срабатывать.

Ошибка, кажется, находится в этой строке:

Sheets (myArray (x)). Диапазон ("A1"). Значение = EntryValue

Любая помощь в том, что я не сделал правильно, очень ценится.

Спасибо.

Вот код:

Sub WorksheetListLoop()

    Dim myArray() As Variant
    Dim EntryValue As String
    Dim ListRange As Range
    Dim cell As Range
    Dim x As Long

    'Set the values to go into range
    Set ListRange = ActiveSheet.ListObjects("tblArrayList").DataBodyRange

    'Resize array prior to loading data
    ReDim myArray(ListRange.Cells.Count)

    'Loop through each cell in range and store sheetname in array
    For Each cell In ListRange.Cells
        myArray(x) = cell.Value
        x = x + 1
    Next cell

    'Use the value in this cell to put into the sheets in the array
    EntryValue = ActiveSheet.Range("D1").Value

    'Loop through list and add value to cell
    For x = LBound(myArray) To UBound(myArray)
        Sheets(myArray(x)).Range("A1").Value = EntryValue
    Next x

End Sub

Answer 1

Допустим, ListRange.Cells.Count равен 9. Массивы по умолчанию начинаются с нуля, а не с единицы.

ReDim myArray(ListRange.Cells.Count) переводит значение от 0 до 9, всего 10 элементов массива.

Следующий код заполняет myArray (0) в myArray (8).

For Each cell In ListRange.Cells
    myArray(x) = cell.Value
    x = x + 1
Next cell

myArray (9) пусто.

Этот код перебирает каждый элемент, включая пустой.

For x = LBound(myArray) To UBound(myArray)
    Sheets(myArray(x)).Range("A1").Value = EntryValue
Next x

На последней итерации, когда x равен UBound (myArray), вы пытаетесь сослаться на пустой элемент массива.

Самое простое решение: поместите Option Base 1 вверху листа модуля с помощью Option Explicit и переместите x = x + 1 выше myArray(x) = cell.Value.

Answer 2

Ваш массив основан на 0, но вы делаете 0 to .Cell.Count, поэтому пустая позиция вызывает ошибку. До .Cells.Count -1

ReDim myArray(ListRange.Cells.Count-1)

Кроме того, используйте явные ссылки на листы, а не Activesheet и исправьте синтаксис для

ActiveSheet("Sheet4")

Может быть,

Worksheets("Sheet4")