根据横向单元格中的值搜索范围 Sheet1 与 Sheet2 中的范围复制到 Sheet3答案

【问题标题】：Searching Range Sheet1 Against Range in Sheet2 Copy to Sheet3 depending on value in lateral cell根据横向单元格中的值搜索范围 Sheet1 与 Sheet2 中的范围复制到 Sheet3
【发布时间】：2016-05-13 20:20:20
【问题描述】：

我已经搜索并发现了一些类似的帖子，例如

Look for values from sheet A in sheet B, and then do function in corresponding sheet B cell 和 For each Loop Will Not Work Search for Value On one Sheet and Change Value on another Sheet

虽然这些都解决了我目标的某些方面，但它们并不完全符合我的目标。我有 3 张工作表，工作表 1 - 3，我想在 A 列和 B 列的工作表 1 - 2 中搜索和匹配，如果在 B 列中找到或未找到匹配项，请检查 A 列中的值是否复制到工作表 3。

这是我目前使用 Office 2016 所拥有的。

Public Sub SeekFindCopyTo()

Dim lastRow1 As Long
Dim lastRow2 As Long
Dim tempVal As String

lastRow1 = Sheets("Sheet1").Range("B" & Rows.Count).End(xlUp).Row
lastRow2 = Sheets("Sheet2").Range("B" & Rows.Count).End(xlUp).Row

For sRow = 4 To lastRow1
    Debug.Print ("sRow is " & sRow)
    tempVal = Sheets("Sheet1").Cells(sRow, "B").Text

    For tRow = 4 To lastRow2
        Debug.Print ("tRow is " & tRow)
        TestVal = Sheets("Sheet2").Cells(tRow, "B")
        Operations = Sheets("Sheet2").Cells(tRow, "A")

        If Sheets("SAP_XMATTERS").Cells(tRow, "B") = tempVal Then
            Operations = Sheets("Sheet2").Cells(tRow, "A")
            Debug.Print ("If = True tempVal is " & tempVal)
            Debug.Print ("If = True TestVal is " & TestVal)
            Debug.Print ("If = True Operaitons is " & Operations)
            If Operations = "REMOVE" Then
                 Sheets("Sheet2").Range("A" & tRow).EntireRow.Copy
                 Sheets("Sheet3").Range("A" & Rows.Count).End(xlUp).Offset(1, 0).Insert xlcutcell
                 'Sheets("Sheet2").Rows(tRow).Delete
            Else
                 'Sheets("Sheet2").Rows(tRow).Delete
            End If
        End If
    Next tRow
Next sRow
End Sub

代码运行良好，但问题是我正在寻找表格 1 和 2 之间的 B:B 中的匹配项，如果匹配我想检查 A:A 中的相邻单元格中的字符串 REMOVE 如果它是 REMOVE 然后复制整个行到 sheet3。这是我还想知道在 B:B 中是否存在与相邻单元格中的字符串 PROCESS 匹配的表格 2 和 1 之间的问题，如果将整行复制到表格 3。我可以在单独的潜艇中执行任一选项，但不能一次完成。

您的帮助将不胜感激，即使它是“你不能那样做”;-)

TIA

鲍勃

【问题讨论】：

快速说明 - 始终使用工作表限定您的范围。你几乎在任何地方都这样做，但检查你的lastRow1 = ... 和lastRow2 = ...，你有Rows.Count，把你想依靠的表放在那里。否则，both lastRow1 和 lastRow2 将使用活动工作表的 Rows.Count。（您也可以稍后在 If Operations = "Remove" ... 循环中执行此操作）。
样本数据可能会有所帮助。

标签： vba excel

【解决方案1】：

使用 .Find 完全重写就可以了。

Sub SeekFindCopy()
    Dim sourceValue As Variant
    Dim resultOfSeek As Range
    Dim targetRange As Range

    LastRow = Sheets("Sheet1").Range("B" & Rows.Count).End(xlUp).Row
    Set targetRange = Sheets("Sheet2").Range("B:B")

    For sourceRow = 4 To LastRow
    Debug.Print ("sRow is " & sRow)

    sourceValue = Sheets("Sheet1").Range("B" & sRow).Value

    Set resultOfSeek = targetRange.Find(what:=sourceValue, After:=targetRange(1))
        'Debug.Print (sourceValue)
    Operations = Sheets("Sheet1").Cells(sRow, "A")
    If resultOfSeek Is Nothing Then
            'Debug.Print ("Operations is " & Operations)
        If Operations = "PROCESS" Then
            Sheets("Sheet1").Range("A" & sRow).EntireRow.Copy
            Sheets("UpLoad").Range("A" & Rows.Count).End(xlUp).Offset(1, 0).Insert xlcutcell
            'Sheets("Sheet1").Rows(tRow).Delete
        End If
    Else
            'Debug.Print ("Operations is " & Operations)
        If Operations = "REMOVE" Then
            Sheets("Sheet1").Range("A" & sRow).EntireRow.Copy
            Sheets("UpLoad").Range("A" & Rows.Count).End(xlUp).Offset(1, 0).Insert xlcutcell
            'Sheets("Sheet1").Rows(tRow).Delete
        End If
    End If
    Next sourceRow
End Sub

【讨论】：