Question

这个网站和VBA的新问题，请耐心等待...我正在编译此数据库，该数据库链接着显示相同项目的图纸编号，但每个图纸都显示了该特定“区域”的不同方面如图所示（希望如此）。我想拥有的功能是能够仅在A列中搜索值，然后返回该值在A列中显示的所有唯一时间以及相应的B列值。我以为即使我只有微不足道的VBA技能，我也可以解决这个问题，但到目前为止我还没有太多。这就是我所拥有的：

Dim ISO As String
Dim Rng As Range
ISO = InputBox("ISO Number: ", "Enter ISO Number")
If Trim(ISO) <> "" Then
    With Sheets("Sheet1").Range("A:A")
        Set Rng = .Find(What:=ISO)
        If Not Rng Is Nothing Then
            Application.Goto Rng, True
        Else
            MsgBox ("Nothing Found")
        End If
    End With
End If

谢谢。

Answer 1

我将使用for循环遍历单元格。

Sub FindMatches()

Dim ISO As String
Dim Rng As Range
Dim lastRow As Long, x As Long
Dim ws As Worksheet
Dim foundCount As Long
Dim endString As String

ISO = InputBox("ISO Number: ", "Enter ISO Number")

If Trim(ISO) <> "" Then
    Set ws = Sheets("Sheet1") ' always best to use a variable for an object if possible
    lastRow = ws.Cells(100000, 1).End(xlUp).Row ' work out how many rows to loop through
    For x = 1 To lastRow ' use a for loop to iterate over each row
        If ws.Cells(x, 1) = ISO Then
            foundCount = foundCount + 1
            endString = endString & ws.Cells(x, 2) & vbNewLine ' add column B to the string
        End If
    Next x
End If

MsgBox "Found " & foundCount & " matches: " & vbNewLine & endString

End Sub

要进行更快的处理，您可以使用一个数组，而不是一次读取一个单元格：

Sub FindMatchesArray()

Dim ISO As String
Dim Rng As Range
Dim lastRow As Long, x As Long
Dim ws As Worksheet
Dim foundCount As Long
Dim endString As String
Dim arr() As Variant

ISO = InputBox("ISO Number: ", "Enter ISO Number")

If Trim(ISO) <> "" Then
    Set ws = Sheets("Sheet1") ' always best to use a variable for an object if possible
    lastRow = ws.Cells(100000, 1).End(xlUp).Row ' work out how many rows to loop through
    arr = ws.Range("A1:B" & lastRow).Value
    For x = 1 To lastRow ' use a for loop to iterate over each row
        If arr(x, 1) = ISO Then
            foundCount = foundCount + 1
            endString = endString & arr(x, 2) & vbNewLine ' add column B to the string
        End If
    Next x
End If

MsgBox "Found " & foundCount & " matches: " & vbNewLine & endString

End Sub

Answer 2

您可以使用Find和FindNext。
前一个Test将在消息框中返回值，第二个将返回的值放在A1上的单元格Sheet2中。
我本可以发誓，这应该可以作为Worksheet函数使用，但是没有运气（.FindNext在UDF中不起作用）。

Sub Test()

    Dim MyMessage As String
    MyMessage = ReturnCountAndValue("5", ThisWorkbook.Worksheets("Sheet1").Columns(1))
    MsgBox MyMessage, vbOKOnly + vbInformation

End Sub

Sub Test2()

    With ThisWorkbook
        .Worksheets("Sheet2").Range("A1") = ReturnCountAndValue(.Worksheets("Sheet1").Range("K2"), _
                                                                .Worksheets("Sheet1").Range("F2:F9"))
    End With

End Sub

Public Function ReturnCountAndValue(SearchValue As String, _
                                    SearchColumn As Range) As String

    Dim rFound As Range
    Dim sFirstAddress As String
    Dim sTempReturn As String
    Dim lCounter As Long

    With SearchColumn
        Set rFound = .Find(What:=SearchValue, LookIn:=xlValues, LookAt:=xlWhole)
        If Not rFound Is Nothing Then
            sFirstAddress = rFound.Address
            Do
                lCounter = lCounter + 1
                sTempReturn = sTempReturn & rFound.Offset(, 1).Value & vbCr
                Set rFound = .FindNext(rFound)

            Loop While rFound.Address <> sFirstAddress

            sTempReturn = lCounter & " items found. " & vbCr & _
                          sTempReturn

        Else

            sTempReturn = SearchValue & " not found in range " & SearchColumn.Address

        End If
    End With

    ReturnCountAndValue = sTempReturn

End Function

VBA搜索单列

2 个答案: