2013-10-14 4 views
0

У меня есть вопрос о моем коде, так как я получаю следующую ошибку (я пробовал несколько разных решений в сети, но почему-то это не решает мою проблему). Я получаю следующую ошибку после окончания цикла (в то время как все работает в цикле): Run Time-error '91' object variable или с переменной блока, которая не установлена. Надеюсь, один из вас может мне помочь! Также есть заметка, где я получаю сообщение об ошибке.Ошибка времени выполнения VBA 91 при финишной петле

Код:

Public Function FilterButton() As Integer 
    Dim SrcSheet As Worksheet, ParSheet As Worksheet 
    Dim SourceRange As Range 
    Dim SrcCell As Range, DestCell As Range 
    Dim firstAddress As String 
    Dim iLastRow As Long, zLastRow As Long 
    Dim Collection As String, System As String, Tag As String 
    Dim iRowInWsPar As Long 
    Dim iError As Integer 
    Dim TagAndSystem As String, Value As String 

    With Application 
     .ScreenUpdating = False 
     .EnableEvents = False 
    End With 

    '~~> Set your sheet 
    Set SrcSheet = Sheets("Imported Data") 
    Set ParSheet = Sheets("Parameters") 

    '~~> Set your ranges 
    '~~> Find Last Row in Col A in the source sheet 
    iLastRow = SrcSheet.Range("A" & SrcSheet.Rows.Count).End(xlUp).Row 
    Set SourceRange = SrcSheet.Range("A2:A" & iLastRow) 

    '~~> Search values 
    Collection = Trim(Range("lblImportCollection").Value) 
    System = Trim(Range("lblImportSystem").Value) 
    Tag = Trim(Range("lblImportTag").Value) 
    TagAndSystem = System & Tag 

    With SourceRange 
     '~~> Match 1st Criteria ("Collection") 
     Set SrcCell = .Find(What:=Collection, LookIn:=xlValues, _ 
       LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, _ 
       MatchCase:=False, SearchFormat:=False) 

     '~~> If found 
     If Not SrcCell Is Nothing Then 
      firstAddress = SrcCell.Address 
      Do 
      'If match 2nd Criteria 
      If ((Len(Trim(System)) = 0) Or (UCase(SrcCell.Offset(, 1).Value) = UCase(System))) Then 
       'Match 3rd criteria 
       If ((Len(Trim(Tag)) = 0) Or (UCase(SrcCell.Offset(, 2).Value) = UCase(TagAndSystem))) Then 

        iRowInWsPar = FindCellfromWsPar(System, Tag) 
        Value = SrcCell.Offset(, 4).Value 
        'Found in the parameter worksheet 
        If iRowInWsPar <> -1 Then 
         iError = ChangeValueinWsPar(iRowInWsPar, Value) 
        End If 

       End If 
      End If 

      Set SrcCell = .FindNext(After:=SrcCell) 
      Loop While (Not SrcCell Is Nothing) And (SrcCell.Address <> firstAddress) 'here i get the error 
     End If 
    End With 

    With Application 
     .ScreenUpdating = True 
     .EnableEvents = True 
    End With 

    FilterButton = 0 

End Function 


'This function will return the row (if found) of the "Parameters" worksheet 
Public Function FindCellfromWsPar(sSystem As String, sTag As String) As Integer 

    Dim ParSheet As Worksheet 
    Dim ParRange As Range 
    Dim SrcCell As Range 
    Dim firstAddress As String 
    Dim iLastRow As Long 


    Set ParSheet = Sheets(mcsWorksheetParameters) 
    With ParSheet 
     iLastRow = .Range("A" & .Rows.Count).End(xlUp).Row 
    End With 

    Set ParRange = ParSheet.Range("A2:A" & iLastRow) 

    FindCellfromWsPar = -1 

    With ParRange 
     '~~> Find sSystem in the "System" column 
     Set SrcCell = .Find(What:=sSystem, LookIn:=xlValues, _ 
       LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, _ 
       MatchCase:=False, SearchFormat:=False) 

     '~~> If found 
     If Not SrcCell Is Nothing Then 
      firstAddress = SrcCell.Address 
      Do 
      'If match Tag 
      If (UCase(SrcCell.Offset(, 1).Value) = UCase(sTag)) Then 
       FindCellfromWsPar = SrcCell.Row 

      End If 

      Set SrcCell = .FindNext(After:=SrcCell) 
      Loop While (Not SrcCell Is Nothing) And (SrcCell.Address <> firstAddress) 
     End If 
    End With 

End Function 

Public Function ChangeValueinWsPar(iRow As Long, sValue As String) 

    Dim ParSheet As Worksheet 
    Dim sValCol As String 

    sValCol = "G" 
    Set ParSheet = Sheets(mcsWorksheetParameters) 

    ParSheet.Range(sValCol & CStr(iRow)).Value = sValue 

End Function 

ответ

0

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

Loop While (Not SrcCell Is Nothing) And (SrcCell.Address <> firstAddress) 'here i get the error 

Вы проверяете, если SrcCell ничего. Но на всякий случай srcCell ничего, он не может вернуть вам адрес, так как диапазон не установлен.

Вы можете решить эту проблему, вложив второе условие в первое. Таким образом, вы не можете запрашивать адрес пустого объекта.

Редактировать: то, что вы можете сделать, например, это цикл в первом условии и ввести второе условие в начале следующего цикла.

+0

Хм, это звучит логично, что вы предлагаете в качестве решения? – user2868444

+0

Проверьте правильность, если это имеет смысл для вас. – Trace

+0

Я сейчас отлаживаю, я проверю, получим ли я правильное решение – user2868444

Смежные вопросы