Ошибка выполнения 91 VBA: цикл по массиву, переданному в пользовательскую функцию

Question

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

Я написал длинный макрос, который по существу использует значения в листе для вычисления шкалы цвета. в зависимости от ограничений, введенных в другом месте на листе. Что мне нужно сделать, это сохранить ячейки в строке от столбца 6 до 17 в массиве, а затем использовать этот массив, чтобы найти максимальное или минимальное значение. Я бы попытался использовать WorksheetFunction.Max, но многие значения будут содержать буквы (у меня есть пользовательская функция, которая преобразует строки в десятичные числа), и если в середине диапазона есть пробелы, это вызывает ошибку. Поэтому я решил обойти эту ошибку, найдя только максимальные значения, которые не являются пустыми.

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

Мне нужна эта функция, чтобы сделать Sub FormatReportCard () более читабельной, так как я использую функции Max и Min в нескольких местах и ​​использую их для математики.

У меня есть Прочтите несколько сообщений на форуме об этой ошибке, и я подозреваю, что мой массив «пуст», что вызывает ошибку времени выполнения функции, но я не могу понять, почему. Я попытался заполнить его фиктивным диапазоном, я пытался использовать () или не использовать () в разных местах. Я пытался переключать различные компоненты между Range и Variant. разные типы переменных. Я попытался использовать окно сообщения, чтобы сказать мне, получает ли массив что-либо назначенное ему, но ошибка времени выполнения не позволяет мне пройти так далеко.

! Вот изображение листа, который отформатирован. ] 1

Sub FormatReportCard()

Dim UpLimit As Single
Dim upConcern As Single
Dim midPoint As Single
Dim LowLimit As Single
Dim lowConcern As Single

Dim rng As Range
Dim rngWhite As Range
Dim size As Integer, rowi As Integer, i As Integer
Dim thisRow() As Range
size = 0
rowi = 0

For Each rng In Range("F5:Q11").Cells

    'Below, we check the row number. If we are on a new row, then we use a for
    'loop to set the size of an array. Then we use another for loop to store
    'all this row's cells for later use.
    If rowi <> rng.Row Then
        For Each rngWhite In Range(Cells(rng.Row, 6), Cells(rng.Row, 17))
            If rng.Value <> "" Then
                size = size + 1
            End If
        Next rngWhite
        ReDim thisRow(1 To size) As Range
        rowi = rng.Row
    End If
    If rowi <> rng.Row Then
        For Each rngWhite In Range(Cells(rng.Row, 6), Cells(rng.Row, 17))
            If rngWhite.Value <> "" Then
                Set thisRow(i) = rngWhite
                MsgBox (thisRow(i))
                i = i + 1
            End If
        Next rngWhite
    End If

    '**Lots of activity that doesn't involve the array**

   midPoint = CustomMax(thisRow)

    '**Do math with the midPoint**

Next rng
End Sub

'_______________________________________________________________________________________________________

Function ConvertToDecimal(angleIn As String) As Variant
    '**Turns industry-specific string combinations into a decimal that can be used in calculations**
End Function

'_______________________________________________________________________________________________________

Function CustomMax(arrayIn() As Range) As Single

Dim i As Integer
Dim vout As Single
Dim flag As Boolean

     For i = LBound(arrayIn) To UBound(arrayIn)
        If Not flag Then
            vout = ConvertToDecimal(arrayIn(i).Value) '**here is where it tells me the object is not set**
            flag = True
        ElseIf ConvertToDecimal(arrayIn(i).Value) > vout Then
            vout = ConvertToDecimal(arrayIn(i).Value)
        End If
    Next i
CustomMax = vout

End Function

Answer 1

РЕДАКТИРОВАТЬ: ваша настоящая проблема, скорее всего, такова -

При первом попадании в новую строку запускается:

If rowi <> rng.Row Then
    For Each rngWhite In Range(Cells(rng.Row, 6), Cells(rng.Row, 17))
        If rng.Value <> "" Then
            size = size + 1
        End If
    Next rngWhite
    ReDim thisRow(1 To size) As Range
    rowi = rng.Row     '<<<< #########
End If

... но последнее, что вы делаете в этом блоке установлен rowi = rng.Row, поэтому следующий блок никогда не запускается:

If rowi <> rng.Row Then
    For Each rngWhite In Range(Cells(rng.Row, 6), Cells(rng.Row, 17))
        If rngWhite.Value <> "" Then
            Set thisRow(i) = rngWhite
            MsgBox (thisRow(i))
            i = i + 1
        End If
    Next rngWhite
End If

---

Вы можете сделать что-то вроде этого:

РЕДАКТИРОВАТЬ - теперь немного ближе к вашему оригинальному методу ...

Sub FormatReportCard()

    Dim rw As Range, n As Long, j As Long, v
    Dim i As Integer
    Dim arr, arr2()

    For Each rw In Range("F5:Q11").Rows
        n = Application.CountA(rw)        'any values?
        If n > 0 Then
            arr = rw.Value                'row as array
            ReDim arr2(1 To n)            'values-only array
            j = 0
            For i = 1 To UBound(arr, 2)   'fill arr2
                v = arr(1, i)
                If Len(v) > 0 Then
                    j = j + 1
                    arr2(j) = ConvertToDecimal(CStr(arr(1, i)))
                End If
            Next i
            Debug.Print "Row: " & rw.Row, Application.Max(arr2), Application.Min(arr2) '<<
        End If

        'etc etc

    Next rw

End Sub

Function ConvertToDecimal(angleIn As String) As Variant
    If Len(angleIn) > 0 Then
        ConvertToDecimal = CDbl(Replace(angleIn, "x", "")) 'for example
    End If
End Function