在工作表 1 中查找值，复制偏移值，在工作表 2 中查找偏移值，在偏移单元格中粘贴文本

Question

我已经研究了很多不同的方法来做到这一点，并尝试将他们的想法纳入这个子程序中，但每次运行它时我总是遇到不同的错误。我正在状态表列出的范围中搜索“0”，并找到偏移值，即车辆编号。然后在 LRV ISSUES 上找到该车辆号码，并将“OOS”粘贴到右侧的一个单元格中。它似乎工作一次然后出错，所以我认为我的循环是错误的。感谢您的帮助。

Sub FindOOS()
Dim c As Range
Dim d As Range
Dim firstAddressC As String
Dim firstAddressD As String
Dim lrv As String

With Worksheets("STATUS SHEET").Range("B5:B37,E5:E37,H5:H37,K5:K37,M5:M35")
    Set c = .Find("0", LookIn:=xlValues)
    If Not c Is Nothing Then
        firstAddressC = c.Address
        Do
            c.Offset(, -1).Value = lrv
            Worksheets("LRV ISSUES").Range("A3:R32").Select
                Set d = .Find(lrv, LookIn:=xlValues)
                d.Offset(, 1).Activate
                ActiveCell.Value = "OOS"
                Worksheets("STATUS SHEET").Select
            Set c = .FindNext(c)
        Loop While Not c Is Nothing
    End If
End With

结束子

Answer 1

Option Explicit

Sub FindOOS()
    Dim c As Range
    Dim d As Range
    Dim firstAddressC As String
    Dim firstAddressD As String
    Dim lrv As String
    
    With Worksheets("STATUS SHEET").Range("B5:B37,E5:E37,H5:H37,K5:K37,M5:M35")
        Set c = .Find("0", LookIn:=xlValues)
        If Not c Is Nothing Then
            firstAddressC = c.Address
            Do
                lrv = c.Offset(, -1).Value  ' **
                With Worksheets("LRV ISSUES").Range("A3:R32")
                    Set d = .Find(lrv, LookIn:=xlValues)
                    If Not d Is Nothing Then
                        d.Offset(, 1).Value = "OOS"
                    End If
                End With
                Set c = .FindNext(c)
            Loop While Not c Is Nothing And c.Address <> firstAddressC
        End If
    End With
End Sub