0

我对我的代码有疑问,我收到以下错误(我在网上尝试了一些不同的解决方案,但不知何故它不能解决我的问题)。结束循环后出现以下错误(而一切都在循环中工作):运行时间错误'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
4

1 回答 1

0

我认为由于您在此处要求代码执行的操作而收到错误:

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

您检查 SrcCell 是否什么都不是。但万一 srcCell 什么都不是,它不能返回地址给你,因为没有设置范围。

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

编辑:例如,您可以做的是在第一个条件上循环,并在下一个循环开始时输入第二个条件。

于 2013-10-14T12:29:34.140 回答