VBA循环遍历范围内的单元格

Question

我正在编写一段代码，它将遍历一张数据表并检查所述数据是否在主表中，如果找不到，它将添加数据。

我正在努力通过For Each Cell in range 来做这件事。但是，我遇到了一个似乎无法解决的问题。这可能只是我很慢，在做了几个小时后没有找到它。

这是我目前所拥有的。我会省略声明。

数据看起来像这样。在我的金表上 1 另一方面，我有： 2

该代码用于获取 sheet1 并查看 sheet2 中是否缺少任何这些股票代码，如果缺少它们只是通知用户。

Set xlsheet1 = Sheets("Gold")
Set xlsheet4 = Sheets("Working Sheet")

xlsheet1.Activate

xllr1 = xlsheet1.Range("B1").End(xlDown).Row
Set xlrange1 = xlsheet1.Range("B1:B" & xllr1)

With Range("A:Z")

鉴于我的数据是动态的，我使用以下 .find 来查找列 带有股票代码。

    Set gs = .Find(what:="Symbol", After:=.Cells(.Cells.Count), LookIn:=xlValues, Lookat:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False)
    gcol = gs.Column
    fr1 = gs.Row + 1
End With

xlsheet4.Activate

xllr4 = xlsheet4.Range("A1").End(xlDown).Row
Set xlrange4 = xlsheet4.Range("A1:A" & xllr3)

这是我遇到问题的地方。当股票代码匹配时它工作正常。我正在考虑插入一行，说 if i = xllr1 and xlcell4.value cells(i, gcol) then etc... 但它似乎不起作用。

xlsheet1.Activate
For i = fr1 To xllr1
    For Each xlcell4 In xlrange4
        If xlcell4.Value = Cells(i, gcol) Then
        Else
            MsgBox "did not find code " & Cells(i, gcol)
        End If
    Next xlcell4
Next i

我希望这是有道理的，并感谢任何帮助！

Answer 1

您需要使用If Not gs Is nothning Then 捕获Find 无法找到“匹配”的场景。

另外，您在我们的Sheets 之间使用了太多不必要的Activate，这需要很长时间才能执行，而是使用完全限定的引用，通过使用With 语句。

当查找匹配 2 个不同工作表中 2 列中的值时，最快和“最干净”的方法是使用一个 For 循环和 Application.Match 函数（请参阅下面的代码中它是如何实现的）。

修改后的代码

Option Explicit

Sub CompareStocks()

Dim xlsheet1 As Worksheet
Dim xlsheet4 As Worksheet
Dim gs As Range, xlrange1 As Range, xlrange4 As Range, C As Range
Dim xllr1 As Long, xllr4 As Long, gcol As Long, fr1 As Long
Dim i As Long

Set xlsheet1 = Sheets("Gold")
Set xlsheet4 = Sheets("Working Sheet")

With xlsheet1
    xllr1 = .Range("B1").End(xlDown).Row
    Set xlrange1 = .Range("B1:B" & xllr1) ' set the Range of Stocks in "Gold" sheet
End With

With xlsheet4
    Set gs = .Cells.Find(what:="Symbol", LookIn:=xlValues, Lookat:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False)
    If Not gs Is Nothing Then  ' find was successful
        gcol = gs.Column
        fr1 = gs.Row + 1
    Else ' <-- Find failed to find a match >> raise an error message
        MsgBox "Unable to find Symbol", vbCritical
        Exit Sub
    End If

    ' set the range of "Symbol"s in "Working Sheet"
    xllr4 = .Cells(.Rows.Count, gcol).End(xlUp).Row ' get last row with data in the column where "Symbol" was found
    Set xlrange4 = .Range(.Cells(1, gcol), .Cells(xllr4, gcol)) ' set the range where all "Symbol"s are located
End With

' ===== Comparing values in 2 columns in 2 worksheets could be achieved with one For loop, and one Application.Match =====
' loop through cells in Stock range in "Gold" sheet
For Each C In xlrange1
    If IsError(Application.Match(C.Value, xlrange4, 0)) Then ' if Match was unable to find a matching record in "Symbol" range in "Working Sheet"
        C.Offset(, 1).Value2 = "Stock not found in " & xlsheet4.Name & " sheet!" ' write an error message to the column on the right
'        MsgBox "did not find code " & .Cells(i, gcol)
    End If
Next C

End Sub  

Answer 2

您可以将正在搜索的值转储到一个数组中：

Dim xlwb As Workbook
Dim xlsheet1 As Worksheet
Dim xlsheet4 As Worksheet
Dim list As Range
Dim listLength As Integer
Dim arr1()

Set xlwb = ThisWorkbook
Set xlsheet4 = xlwb.Sheets("Working Sheet")

listLength = xlsheet4.Range("A1").End(xlDown).Row
Set list = xlsheet4.Range("A1:A" & listLength)

ReDim arr1(listLength)
j = 0

For Each xlCell in list
    arr1(j) = xlCell
    j = j + 1
Next xlCell

然后在数组中搜索每个元素：

Set xlsheet1 = xlwb.Sheets("Gold")
Set list = xlsheet1.Range("B1:B" & xlsheet1.Range("B1").End(xlDown).Row)

For Each xlCell in list

    found = False

    For j = 0 To UBound(arr1)
        If arr1(j) = xlCell Then
            found = True
        EndIf
    Next j

    If Not found MsgBox "Element not found: " & xlCell

Next xlCell

这只是如何做到这一点的另一种可能性！