Excel VBA根據匹配標準在不同工作表中複製相鄰列

Question

如果列A中的值與工作表2中同一列中的值匹配，那麼我有一個宏來檢查工作表1，如果是，它將爲每個將sheet1中的值匹配到sheet2中。下面是我到目前爲止，但我不斷收到lastrowadd線'運行時錯誤9'，我不知道爲什麼。任何幫助，將不勝感激:)

Sub CopyAdjacent() 
    Dim i As Long, j As Long, colStatus As Long, lastrowAdd As Long, lastrowRemove As Long 

    colStatus = 2 'your status column number 
    lastrowAdd = Sheets(「Sheet1」).Cells(Sheets(「Sheet1」).Rows.Count, 1).End(xlUp).Row 
    lastrowRemove = Sheets(「Sheet2」).Cells(Sheets(「Sheet2」).Rows.Count, 1).End(xlUp).Row 

    For i = 1 To lastrowAdd 
     For j = 1 To lastrowRemove 
      If Sheets(「Sheet1」).Cells(i, 1).Value = Sheets(「Sheet2」).Cells(j, 1).Value Then 
       Sheets(「Sheet2」).Cells(j, colStatus).Value = Sheets(「Sheet1」).Cells(i, colStatus).Value 
      End If 
     Next j 
    Next i 
End Sub 

Answer 1

一對小情侶已經作了修改既包括lastrowAdd和lastrowRemove已定義的方式。我也從定義中刪除了i和j。

Sub CopyAdjacent() 
Dim colStatus As Long, lastrowAdd As Integer, lastrowRemove As Integer 

colStatus = 2 
lastrowAdd = Sheets(「Sheet1」).Cells(Rows.Count, 1).End(xlUp).Row 
lastrowRemove = Sheets(「Sheet2」).Cells(Rows.Count, 1).End(xlUp).Row 

For i = 1 To lastrowAdd 
    For j = 1 To lastrowRemove 
     If Sheets(「Sheet1」).Cells(i, 1).Value = Sheets(「Sheet2」).Cells(j, 1).Value Then 
      Sheets(「Sheet2」).Cells(j, colStatus).Value = Sheets(「Sheet1」).Cells(i, colStatus).Value 
     End If 
    Next 
Next 
End Sub 

此外，這不檢查是否在同一列上兩個匹配。它從Sheet1檢查每一列Sheet2與每一列。我認爲下面的代碼是你正在尋找的。

Sub CopyAdjacent() 
' The below line has been changed, you may still omit lastrowRemove 
Dim colStatus, lastrowAdd, lastrowRemove As Integer 

colStatus = 2 
lastrowAdd = Sheets(「Sheet1」).Cells(Rows.Count, 1).End(xlUp).Row 
' The below line is now redundant in the new code 
'lastrowRemove = Sheets(「Sheet2」).Cells(Rows.Count, 1).End(xlUp).Row 

For i = 1 To lastrowAdd 
     If Sheets(「Sheet1」).Cells(i, 1).Value = Sheets(「Sheet2」).Cells(i, 1).Value Then 
      Sheets(「Sheet2」).Cells(i, colStatus).Value = Sheets(「Sheet1」).Cells(i, colStatus).Value 
     End If  
Next 
End Sub