Question

我在sheet2中有船舶数据列表。第一列是船舶名称，其他列是船舶的详细信息。下面的一行是另一艘船，依此类推。我想要做的是在sheet1中复制一行船舶数据并将其粘贴到sheet2，但如果sheet2已经有了这艘船，我希望sheet2的那一行用sheet1中的复制一行替换。< / p>

到目前为止我得到的是从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

我修改了你的代码并添加了一个部件，以便在sheet2中的sheet1（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

Answer 2

下面：

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

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

2 个答案: