如果复制行的第一列值匹配，覆盖整行粘贴

Question

我有sheet2中的船舶数据列表。第一栏是船名，其他栏是船的详细信息。下面一排是另一艘船等。我想要做的是在sheet1中复制一行船舶数据并将其粘贴到sheet2，但是如果sheet2已经拥有那艘船，我希望将sheet2行中的船用从sheet1复制的一行替换。

到目前为止，我从sheet1复制了行并将其粘贴到sheet2的第一个可用空行，然后按字母顺序排序：P。所以我有很多与同一艘船的行。

这里是我的代码：

Private Sub CommandButton2_Click() 

Application.ScreenUpdating = False 
Dim copySheet As Worksheet 
Dim pasteSheet As Worksheet 

Set copySheet = Worksheets("sheet1") 
Set pasteSheet = Worksheets("sheet2") 

copySheet.Range("A5:AT5").Copy 

pasteSheet.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).PasteSpecial  xlPasteValues 

Application.CutCopyMode = False 

Worksheets("sheet2").Activate 

Sheets("sheet2").Range("A2").CurrentRegion.Select 

Selection.Sort Key1:=Sheets("sheet2").Range("A1"), Order1:=xlAscending, Header:=xlYes, _ 
    OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _ 
    DataOption1:=xlSortNormal 

Set Rng = Nothing 


Application.CutCopyMode = False 
Application.ScreenUpdating = True 

End Sub 

Answer 1

这里：

Private Sub CommandButton2_Click() 
Application.ScreenUpdating = False 
Dim Rng As Range 

Sheets("Sheet1").Range("A5:AT5").Copy ' copies the row mentioned 

Sheets("Sheet2").Activate 
Set Rng = Range("A:A").Find(What:=Sheets("Sheet1").Range("A5").Value, LookIn:=xlValues, LookAt:=xlWhole, MatchCase:=True) ' Check to see if ship is already in sheet2 ("Rng = nothing" means it's not, "Rng = [Ship's name]" means it is) 

If Not Rng Is Nothing Then 'if it's not nothing, it's somthing (ship's name) 
    Rng.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False 'Pastes over old record of ship 
    Else 
     Range("A" & Range("A" & Cells.Rows.Count).End(xlUp).Row + 1).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False ' enters ne entry for ship 
End If 

Application.CutCopyMode = False 

Sheets("sheet2").Range("A2").Sort Key1:=Sheets("sheet2").Range("A1"), Order1:=xlAscending, Header:=xlYes, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, DataOption1:=xlSortNormal 

Set Rng = Nothing 

Application.CutCopyMode = False 
Application.ScreenUpdating = True 

End Sub 

Answer 2

我修改了代码，增加了部分找到在工作表Sheet1 Sheet2的（A5）船舶。如果找到，代码将替换其他数据添加到数据末尾的数据。

Sub CopyShip() 

Dim copySheet As Worksheet 
Dim pasteSheet As Worksheet 

Set copySheet = Worksheets("sheet1") 
Set pasteSheet = Worksheets("sheet2") 

Dim rowToCopy As Integer 
rowToCopy = 5 ' this variable in case a for loop is implemented in future 

Dim findShip As Range 

'find current ship in sheet2 
Set findShip = pasteSheet.Cells.Find(What:=copySheet.Range("A" & rowToCopy), LookIn:=xlFormulas, _ 
     LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, _ 
     MatchCase:=False, SearchFormat:=False) 


copySheet.Range("A" & rowToCopy & ":AT" & rowToCopy).Copy 
If findShip Is Nothing Then 
    'current ship was not found 
    pasteSheet.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues 
    Else 
    'ship with same name was found 
    'assuming all data is within columns A to AT 
    'other wise need to clear the entire row before pasting 
    pasteSheet.Cells(findShip.Row, 1).PasteSpecial xlPasteValues 
End If 


Application.CutCopyMode = False 
Worksheets("sheet2").Activate 
Sheets("sheet2").Range("A2").CurrentRegion.Select 
Selection.Sort Key1:=Sheets("sheet2").Range("A1"), Order1:=xlAscending, Header:=xlYes, _ 
    OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _ 
    DataOption1:=xlSortNormal 

End Sub