Question

我遇到一种情况，我在A列中有数字。我想知道是否在B列中找到了这些数字。例如：A1的数字为5554，A2的数字为163。B1是00051631，B2是0000055549 。该代码应执行以下操作：搜索B列中的单元格之一是否包含5554。然后移至A2并执行相同的操作。

因此，这两个字段都应返回“ true”，因为A列中的两个数字都存在于B列的单元格中。

Sub Search()

Dim StartCell As Integer
Dim EndCell As Integer
Dim i As Integer 'row counter
Dim x As Integer 'row counter2
Dim InvoiceNumber As Integer


StartCell = Worksheets("Sheet1").Range("A1")
EndCell = Worksheets("Sheet1").Range("A1048576").End(xlUp).Row

For i = 1 To EndCell
    InvoiceNumber = Cells(i, 1)
    If InStr(1, Cells(i, 2), InvoiceNumber) > 0 Then
    Cells(i, 3).Value = InvoiceNumber
    End If

Next i

End Sub

所以基本上，上面的操作是如果A1存在于B1中，但是它不会继续检查B2，依此类推...

有解决方案吗？

谢谢！

Answer 1

_假设：

您的两列实际上都是数字，其格式设置为文本（按照前导零）
您需要根据您的声明返回TRUE或FALSE："....Therefore both of these should return "true"

您可以决定不一次又一次地遍历B列。相反，您可以执行Find在B列的值内查找值：

_{示例代码：}

Sub Test()

Dim lr1 As Long, lr2 As Long, x As Long
Dim arr As Variant
Dim rng As Range, cl As Range

With Sheet1 'Change according to your sheets CodeName

    'Fill the array for a loop in memory
    lr1 = .Cells(.Rows.Count, 1).End(xlUp).Row
    arr = .Range("A1:A" & lr1)

    'Get the range to look in
    lr2 = .Cells(.Rows.Count, 2).End(xlUp).Row
    Set rng = .Range("B1:B" & lr2)

    'Loop over the array and perform the search
    For x = LBound(arr) To UBound(arr)
        Set cl = rng.Find(arr(x, 1), LookIn:=xlValues)
        If Not cl Is Nothing Then
            .Cells(x, 3) = True 'If you want to insert boolean value
            '.Cells(x,3) = cl 'If you want to insert the found value
            '.Cells(x,3) = arr(x,1) 'If you want to insert the search value
        Else
            .Cells(x, 3) = False
        End If
    Next 

End With

End Sub

另一种方法是在没有Find的情况下遍历内存：

Sub Test()

Dim lr1 As Long, lr2 As Long, x As Long
Dim arr1 As Variant, arr2 As Variant, arr3 As Variant

With Sheet1 'Change according to your sheets CodeName

    'Fill the first array for a loop in memory
    lr1 = .Cells(.Rows.Count, 1).End(xlUp).Row
    arr1 = .Range("A1:A" & lr1)

    'Fill the second array for a filter
    lr2 = .Cells(.Rows.Count, 2).End(xlUp).Row
    arr2 = Application.Transpose(Application.Index(.Range("B1:B" & lr2), 0, 1))

    'Loop over the array and perform the search
    For x = LBound(arr1) To UBound(arr1)

        'Return an array of filtered values
        arr3 = Filter(arr2, arr1(x, 1))

        'Do something with the returned array
        If UBound(arr3) > -1 Then
            .Cells(x, 3) = True 'If you want to insert boolean value
            '.Cells(x,3) = arr3(1) 'If you want to insert the found value
            '.Cells(x, 3) = Join(arr3, ",") 'if you want to show all found values
            '.Cells(x,3) = arr(x,1) 'If you want to insert the search value
        Else
            .Cells(x, 3) = False
        End If
    Next

End With

End Sub

在两种情况下，您都可能需要确保还将C列的格式设置为文本。

Answer 2

您根本不会遍历B列，这就是您遇到问题的原因。

最好将行号存储在变量中并在这些变量之间循环：

Dim startRow As Long, endRow As Long
For aRow = startRow To endRow
  invoiceNumber = Cells(aRow, 1).Value
  For bRow = startRow To endRow
    If InStr(1, Cells(bRow, 2).Value, invoiceNumber) > 0 Then
      Cells(aRow, 3).Value = invoiceNumber
      Exit For
    End If
  Next
Next

Answer 3

这是我的版本

Sub Search()

Dim StartCell As Integer
Dim CellSource As Range
Dim CellSearch As Range
Dim SourceRange As Range
Dim SearchRange As Range
Dim testValue As String


Dim i As Integer 'row counter
Dim x As Integer 'row counter2
Dim InvoiceNumber As Integer


StartCell = Worksheets("Sheet1").Range("A1") ' a you sure you need this?
SourceRange = Range(Cells(Rows.Count, 1).Cells(Rows.Count, 1).End(xlUp))
SearchRange = Range(Cells(Rows.Count, 1).Cells(Rows.Count, 1).End(xlUp))


For Each CellSource In SourceRange
    For Each CellSearch In SearchRange
        testValue = "*" & CellSource & "*"
        If CellSearch Like testValue Then
            CellSource.Offset(0, 2).Value = CellSource
        End If
    Next
Next i

End Sub

Answer 4

我知道您正在使用VBA，但是您知道可以使用Excel公式以几种方式完成此操作：

=INDEX(B:B, MATCH("*" &A1&"*",B:B,0))

VBA搜索遍历范围

4 个答案: