Question

目前，我正在搜索一栏。但我仍然坚持如何搜索两个或多个字段以提出更多特定结果。

我正在尝试将搜索范围从1缩小到2，以显示更具体的数据。谁能帮忙。提前致谢。感谢帮助!!!!!

Public CallDetails As Collection

Public Function Find_CallNumbers(NumberToFind As String) As Collection

Dim rng_to_search As Range
Dim rFound As Range
Dim FirstAddress As String
Dim FoundItem As clsCallDetails

Set CallDetails = New Collection

With ThisWorkbook.Worksheets("Database")
    Set rng_to_search = .Range(.Cells(1, 1), .Cells(.Rows.Count, 1).End(xlUp))
End With

With rng_to_search
    'Look for the first instance.
    Set rFound = .Find(what:=NumberToFind, _
                       after:=.Cells(1, 1), _
                       LookIn:=xlValues, _
                       LookAt:=xlPart, _
                       SearchDirection:=xlNext)
    If Not rFound Is Nothing Then
        FirstAddress = rFound.Address
        Do
            Set FoundItem = New clsCallDetails 'Create a new instance of the class to hold the details.
            With FoundItem
                .Title = rFound.Offset(, 7) 'CORRECT
                .LoggedBy = rFound.Offset(, 2) 'CORRECT .Offset from column A by 1 column, so column B.
                .CallNumber = rFound.Offset(, 3) 'CORRECT
                .DateField = rFound.Offset(, 4) 'CORRECT
                .OwnerField = rFound.Offset(, 6) 'CORRECT
                .Description = rFound.Offset(, 8) 'CORRECT
                .Solution = rFound.Offset(, 9) 'CORRECT
                .URLImage = rFound.Offset(, 10) 'CORRECT
                .DateResolved = rFound.Offset(, 5) 'CORRECT
                .Reference = rFound.Offset(, 1) 'CORRECT

            End With
            CallDetails.Add FoundItem 'Add the class instance to our collection.
            Set rFound = .FindNext(rFound) 'Look for the next value.

        'Continue searching until we reach the top again.
        Loop While Not rFound Is Nothing And rFound.Address <> FirstAddress
    End If
End With

End Function

Private Sub PlaceValues(Index As Long)
With Me
    .txtLoggedBy.Value = CallDetails(Index).LoggedBy
    .txtCallNumber.Value = CallDetails(Index).CallNumber
    .txtDateField.Value = CallDetails(Index).DateField
    .txtTitle.Value = CallDetails(Index).Title
    .cmbOwnerField.Value = CallDetails(Index).OwnerField
    .txtDescription.Value = CallDetails(Index).Description
    .txtSolution.Value = CallDetails(Index).Solution
    .txtURLImage.Value = CallDetails(Index).URLImage
    .txtDateResolved.Value = CallDetails(Index).DateResolved
    .txtReference.Value = CallDetails(Index).reference
End With
End Sub

Answer 1

这应该给你一个非常基本的想法。该函数允许将每个变量传递给函数。这些是可选的，因此无需提供。然后测试针对已找到的值提供的值，如果它们匹配，则将Score增加1.如果最终得分超过或等于Tolerance则添加它到您的自定义集合。您需要对正确的数据类型和比较方法稍作修改。

Public CallDetails As Collection

Public Function Find_CallNumbers(NumberToFind As String, Optional Title As String, Optional LoggedBy As String, _
    Optional CallNumber As Long, Optional DateField As Long, Optional OwnerField As String, Optional Description As String, _
    Optional Solution As String, Optional URLImage As String, Optional DateResolved As Long, Optional reference As String) As Collection

    Dim rng_to_search As Range
    Dim rFound As Range
    Dim FirstAddress As String
    Dim FoundItem As clsCallDetails
    Dim Score As Long
    Dim Tolerance As Long

    Set CallDetails = New Collection

    With ThisWorkbook.Worksheets("Database")
        Set rng_to_search = .Range(.Cells(1, 1), .Cells(.Rows.Count, 1).End(xlUp))
    End With

    Tolerance = 8

    With rng_to_search
        'Look for the first instance.
        Set rFound = .Find(what:=NumberToFind, _
                           after:=.Cells(1, 1), _
                           LookIn:=xlValues, _
                           LookAt:=xlPart, _
                           SearchDirection:=xlNext)
        If Not rFound Is Nothing Then
            FirstAddress = rFound.Address
            Do
                With rFound
                    If Title = rFound.Offset(, 7) Then Score = Score + 1
                    If LoggedBy = rFound.Offset(, 2) Then Score = Score + 1
                    If CallNumber = rFound.Offset(, 3) Then Score = Score + 1
                    If DateField = rFound.Offset(, 4) Then Score = Score + 1
                    If OwnerField = rFound.Offset(, 6) Then Score = Score + 1
                    If Description = rFound.Offset(, 8) Then Score = Score + 1
                    If Solution = rFound.Offset(, 9) Then Score = Score + 1
                    If URLImage = rFound.Offset(, 10) Then Score = Score + 1
                    If DateResolved = rFound.Offset(, 5) Then Score = Score + 1
                    If reference = rFound.Offset(, 1) Then Score = Score + 1
                End With

                If Score >= Tolerance Then
                    Set FoundItem = New clsCallDetails 'Create a new instance of the class to hold the details.
                    With FoundItem
                        .Title = rFound.Offset(, 7) 'CORRECT
                        .LoggedBy = rFound.Offset(, 2) 'CORRECT .Offset from column A by 1 column, so column B.
                        .CallNumber = rFound.Offset(, 3) 'CORRECT
                        .DateField = rFound.Offset(, 4) 'CORRECT
                        .OwnerField = rFound.Offset(, 6) 'CORRECT
                        .Description = rFound.Offset(, 8) 'CORRECT
                        .Solution = rFound.Offset(, 9) 'CORRECT
                        .URLImage = rFound.Offset(, 10) 'CORRECT
                        .DateResolved = rFound.Offset(, 5) 'CORRECT
                        .reference = rFound.Offset(, 1) 'CORRECT
                    End With
                    CallDetails.Add FoundItem 'Add the class instance to our collection.
                    Set rFound = .FindNext(rFound) 'Look for the next value.
                End If
                Score = 0

            'Continue searching until we reach the top again.
            Loop While Not rFound Is Nothing And rFound.Address <> FirstAddress
        End If
    End With

End Function

您的班级也要保留Score值，您只需添加

即可

Private pScore As Long
Public Property Get Score() As Long
    Score = pScore
End Property
Public Property Let Score(value As Long)
    pScore = value
End Property

到clsCallDetails

Userform从数据范围中搜索两列

1 个答案: