[英]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.