Question

我的项目在Sheet1上有旧信息，我将新数据导入Sheet2。 A列（两张纸上）包含一个4位数字。我想要做的是找到Sheet1上与Sheet2上的新信息具有相同4位数的行（以确保我更新正确的信息）并用新的覆盖旧条目（我也强调它是否有更改日期，但此时并不重要;日期在E列中。此外，如果Sheet1上没有相应的条目，我希望能够在下一个可用行中创建一个新条目。我到目前为止编写的代码确实可以用于一行，但是遇到了我遇到问题的问题：

当没有匹配时，Do While循环将永远运行。
我无法弄清楚如何遍历我想在Sheet1上搜索的所有单元格以及Sheet2上的所有搜索条件（我以为我必须在Sheet1 Col上检查每个单元格的信息对于Sheet2上的每个搜索字词，但是从我在网上看到的所有内容来看，似乎必须有更好的方法，但我太绿了，无法弄清楚。）

代码：

Private Sub DoWork()
    Dim billOr As Range
    Dim billTgt As Range
    Dim tgtCell As Range
    Dim orCell As Range
    Dim compareBill As Integer
    Dim compareDate As Integer
    Dim x As Integer
    Dim i As Integer

    i = 1
    x = 2
    Set billOr = Sheets("Sheet2").Range("A" & i)
    Set billTgt = Sheets("Sheet1").Range("A" & x)
    Set orCell = Sheets("Sheet2").Range("E" & i)
    compareBill = InStr(billOr.Value, billTgt.Value)

    Do While compareBill <> 1
        compareBill = InStr(billOr.Value, billTgt.Value)
        Set billTgt = billTgt.Offset(1, 0)
    Loop

    Set tgtCell = Sheets("Sheet1").Range("E" & x)
    compareDate = InStr(orCell, tgtCell)

    If compareDate = 0 Then
        tgtCell.EntireRow.Value = orCell.EntireRow.Value
        tgtCell.EntireRow.Interior.ColorIndex = 6
    Else
        tgtCell.EntireRow.Value = orCell.EntireRow.Value
    End If
End Sub

任何帮助都会受到赞赏，即使它只是指向我正确的方向。

Answer 1

忽略日期部分：

Private Sub DoWork()

    Dim billOr As Range
    Dim billTgt As Range
    Dim shtDest as Worksheet

    Set billOr = Sheets("Sheet2").Range("A1")
    Set shtDest = Sheets("Sheet1")

    Do While billOr.value <> ""

        Set billTgt = shtDest.columns(1).find(billOr.value, _
                                              lookat:=xlwhole)
        If billTgt Is Nothing Then
            Set billTgt = shtDest.cells(rows.count,1) _
                          .End(xlUp).Offset(1,0)
            Debug.Print "copying new row to " & billTgt.Address()
        End If

        billOr.entirerow.copy billTgt

        Set billOr = billOr.Offset(1,0)
    Loop 

End Sub

复制与搜索数据对应的行

1 个答案: