繁体   English   中英

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

[英]Searching Range Sheet1 Against Range in Sheet2 Copy to Sheet3 depending on value in lateral cell

我搜索并发现了一些类似的帖子

从工作表B中的工作表A中查找值,然后在相应的工作表B单元格中执行操作,并且对于每个循环将 无法 工作在一个工作表上搜索值并在另一个工作表上更改值

虽然每一个都解决了我的目标的某些方面,但他们并不是这样。 我有3张,sheet1 - 3,我想在列A和B上的sheet1 - 2中搜索和匹配,如果找到匹配或在B列中找不到匹配,则检查A列中的值是否复制到sheet3。

这是我到目前为止使用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

代码工作得很好,但问题是我正在寻找表格2和表格2之间的B:B匹配如果匹配我想检查A:A中的相邻单元格,如果它是REMOVE则删除字符串REMOVE然后将整行复制到sheet3 。 这里的问题我也想知道,如果B和B之间没有匹配,则在Sheets 2和1之间没有匹配,相邻单元格中的字符串PROCESS,如果这样,则将整行复制到sheet3。 我可以在单独的潜艇中做任何一个选项,但不能让它在一次通过中运行。

即使它是“你不能那样做”的线路,你的帮助也会受到赞赏;-)

TIA

短发

使用.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

暂无
暂无

声明:本站的技术帖子网页,遵循CC BY-SA 4.0协议,如果您需要转载,请注明本站网址或者原文地址。任何问题请咨询:yoyou2525@163.com.

 
粤ICP备18138465号  © 2020-2024 STACKOOM.COM