Переменная объекта или переменная блока не установлена ​​(ошибка 91) случайно? - PullRequest
0 голосов
/ 26 марта 2020

Ошибка выскакивает в этой строке MOnachbar = FindMO_1.Offset(, off), кажется, что это почти случайно происходит, что я сейчас не верно. Ниже мой код. Я запускал его несколько раз с разными диапазонами, и он не показал ошибок. У меня есть около 5000 строк x && столбцов, через которые я должен пройти l oop, здесь я проверяю их только для одной конкретной строки.

Sub test_array()

    'On Error Resume Next
    Application.ScreenUpdating = False
    Dim StartTime As Double
    Dim TimeTaken As Double
    StartTime = Timer
    Dim wb As Workbook
    Set wb = ThisWorkbook
    Dim myRange As Range
    Dim sArr As Variant
    Dim MORange As Range
    Dim i As Long
    Dim j As Long
    Set MORange = wb.Worksheets("INPUT_WIND").Range("C2:BP2")
    Set myRange = wb.Worksheets("INPUT_WIND").Range("C950:BP950")
    Dim MO As String
    Dim off As Long
    Dim WeaMat As Range
    Set WeaMat = Workbooks.Open("C:\Users\Nikhil.srivatsa\Desktop\WeaMat").Worksheets(1).Range("A:A")
    Dim FindMO_1 As Range
    Dim MOnachbar As String
    Dim FindMO_2 As Range
    Dim MOcol As Long
    Dim Vneu As Long
    Dim desRange As Range 'destination range
    Dim ZeitStempel As String
    Dim FINORange As Range
    Dim FINDZeitStempel As Range
    Dim VFINO As Long
    Dim DateRange As Range
    Set DateRange = wb.Worksheets("INPUT_WIND").Range("B3:B950")
    Set FINORange = Workbooks.Open("C:\Users\Nikhil.srivatsa\Desktop\FINO raw-010119-310819").Worksheets(1).Range("A:A") 'öffnet FINO Datei und legt die SuchRange fest
    wb.Sheets.Add(after:=wb.Worksheets("INPUT_WIND")).Name = "Ersetzt" ' create new sheet
    Set desRange = wb.Worksheets("Ersetzt").Range("C950:BP950") 'Range im neuen Sheet

    DateRange.Copy wb.Worksheets("Ersetzt").Range("B3:B950") 'Dates und MOs rüberkopieren
    MORange.Copy wb.Worksheets("Ersetzt").Range("C2:BP2") 'Dates und MOs rüberkopieren
    sArr = myRange.Value 'Creates Array of All cells

    For i = LBound(sArr, 1) To UBound(sArr, 1) 'Rows

        For j = LBound(sArr, 2) To UBound(sArr, 2) 'Columns

            If sArr(i, j) <= 0 Or IsEmpty(sArr) = True Then

                off = 1

                Do While off <= 5
                    MO = MORange.Cells(1, j)
                    Debug.Print MO
                    Set FindMO_1 = WeaMat.Find(MO, lookat:=xlWhole, MatchCase:=False, SearchFormat:=False) 'Lookup MO in WEA MAtrix
                    MOnachbar = FindMO_1.Offset(, off)
'                   Debug.Print MOnachbar
                    Set FindMO_2 = MORange.Find(MOnachbar, lookat:=xlWhole, MatchCase:=False, SearchFormat:=False) 'lookup MONachbar in INPUT_WIND

                    MOcol = FindMO_2.Column - 2 'column Index für sArr
                    Vneu = sArr(i, MOcol)
                    Debug.Print Vneu

                    If Vneu > 0 And IsEmpty(Vneu) = False Then
                        sArr(i, j) = Vneu 'array value wurde ersetzt
                        desRange.Cells(i, j).AddComment.Text "Ersetzt durch" & " " & MOnachbar 'Kommentar
                        desRange.Cells(i, j).Font.Bold = True 'Bold font
                    Exit Do

                End If

                off = off + 1

                If off > 5 Then 'durch FINO daten ersetzen da mehr als 5 umliegende Anlagen entweder Blank oder 0 sind

                    ZeitStempel = myRange.Cells(i, j).Offset(, -j) 'als String / Text
'                   Debug.Print ZeitStempel

                    Set FINDZetiStempel = FINORange.Find(CDate(ZeitStempel), lookat:=xlWhole, MatchCase:=False, SearchFormat:=True) 'Cdate String ins Date umwandeln
                    If Not FINDZeitStempel Is Nothing Then

                        VFINO = FINDZeitStempel.Offset(, 1) 'FINO Wert
                        sArr(i, j) = VFINO
                        desRange.Cells(i, j).AddComment.Text "Ersetzt durch" & " " & "FINO" 'Kommentar
                        desRange.Cells(i, j).Font.Bold = True 'Bold font
                        Exit Do
                    Else
'                       Debug.Print "Zeitstempel nicht gefunden" & " " & ZeitStempel
                        ErrCnt = ErrCnt + 1
                        Exit Do
                    End If

                End If

              Loop

          End If

       Next j
    Next i

    desRange.Value = sArr

'   wb.Worksheets("Ersetzt").Range("C2").Select

    Workbooks("WeaMat").Close False 'close WeaMat without saving
    Workbooks("FINO raw-010119-310819").Close False 'close FINO datei ohne sie zu spiechern
    Application.Calculation = xlCalculationAutomatic
    TimeTaken = Round((Timer - StartTime) / 86400, 2)
    Debug.Print TimeTaken
    If ErrCnt <> 0 Then

        MsgBox "fertig in" & " " & TimeTaken & " " & "Sekunden" & vbCrLf & "einige FINO Zeitstempeln wurden nicht gefunden"
    Else

        MsgBox "fertig in" & " " & TimeTaken & " " & "Sekunden"
    End If
    Application.ScreenUpdating = True

End Sub

1 Ответ

1 голос
/ 26 марта 2020

Измените это:

Set FindMO_1 = WeaMat.Find(MO, lookat:=xlWhole, MatchCase:=False, SearchFormat:=False) 'Lookup MO in WEA MAtrix
MOnachbar = FindMO_1.Offset(, off)
' etc...

На это:

Set FindMO_1 = WeaMat.Find(MO, lookat:=xlWhole, MatchCase:=False, SearchFormat:=False) 'Lookup MO in WEA MAtrix
If FindMO_1 Is Nothing Then
    ' show an error message? break-out of a loop? exit the function?
    MsgBox "Find returned nothing"
    Exit Sub
Else
    MOnachbar = FindMO_1.Offset(, off)
    ' etc... 
End If

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

(я изначально полагал, что VBA имеет область видимости на уровне блоков, как, например, C и Java, но сегодня я узнал, что имеет только функцию / sub -уровень, так что мое предыдущее утверждение о том, что перемещение объявлений не позволит использовать переменную вне области видимости, было неверным).

Dim FindMO_1 As Range
Set FindMO_1 = WeaMat.Find(MO, lookat:=xlWhole, MatchCase:=False, SearchFormat:=False) 'Lookup MO in WEA MAtrix
If FindMO_1 Is Nothing Then
    ' show an error message? break-out of a loop? exit the function?
    MsgBox "Find returned nothing"
    Exit Sub
Else
    MOnachbar = FindMO_1.Offset(, off)
    ' etc... 
End If

Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...