Question

我有一个关于我的代码的问题我得到了以下错误（我在网上尝试了一些不同的解决方案，但不知怎的，它没有解决我的问题）。结束循环后我得到以下错误（虽然一切都在循环中工作）：运行时间错误'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

Answer 1

我认为你得到的错误是因为你要求代码在这里做的事情：

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

你检查SrcCell是否一无所获。但是，以防srcCell什么都没有，它不能返回给你的地址，因为范围没有设置。

您可以通过在第一个条件中嵌套第二个条件来解决此问题。这样，您就不能要求空对象的地址。

编辑：例如，你可以做的是在第一个条件下循环，并在下一个循环开始时输入第二个条件。

完成循环时VBA运行时错误91

1 个答案: