当单元格下拉列表“是”时，在不同的工作表中复制Excel行，如果之前select“是”，则“否”删除行

我试图在单元格下拉列F的“是”时，在不同的工作表工作表2中复制Excel行，如果以前select“是”，则“否”删除该行。 我也想检查工作表2中是否存在重复，然后用“是”，“否”button提示用户。 如果“是”则重复“否”不做任何事情。

ColA:Customer Name ColB:Customer Address ColC:Customer City ColD:Cust zip ColE:Tel ColF:Yes/No 

我已经试过了。

 Private Sub Worksheet_SelectionChange(ByVal Target As Range) Dim lastrow As Long If UCase(Range("F" & ActiveCell.Row).Value) <> "YES" Then Exit Sub With ThisWorkbook.Worksheets("Sheet2") lastrow = Application.Max(4, .Cells(.Rows.Count, "A").End(xlUp).Row + 1) If WorksheetFunction.CountIf(.Range("A1:A" & lastrow), _ Range("A" & ActiveCell.Row).Value) > 0 Then Exit Sub Response = MsgBox("Record already exists, add again?", vbQuestion + vbYesNo + 256) If Response = vbNo Then Exit Sub .Range("A" & lastrow).Resize(, 5).Value = _ Range("A" & ActiveCell.Row).Resize(, 5).Value End With Response = MsgBox("Record added") End Sub 

Answer 1

如果我正确地理解了你，你需要类似这样的东西（只有在列F改变的值时，代码才会运行）：

 Private Sub Worksheet_Change(ByVal Target As Range) Dim lastrow As Long Dim Response Dim rng As Range, rngToDel As Range Dim fAddr As String If Intersect(Target, Range("F:F")) Is Nothing Then Exit Sub Application.EnableEvents = False On Error GoTo ErrHandler With ThisWorkbook.Worksheets("Sheet2") lastrow = Application.Max(4, .Cells(.Rows.Count, "A").End(xlUp).Row + 1) If UCase(Target.Value) = "YES" Then Response = vbYes If WorksheetFunction.CountIf(.Range("A1:A" & lastrow), _ Range("A" & Target.Row).Value) > 0 Then Response = MsgBox("Record already exists, add again?", vbQuestion + vbYesNo + 256) End If If Response = vbYes Then .Range("A" & lastrow).Resize(, 5).Value = _ Range("A" & Target.Row).Resize(, 5).Value MsgBox "Record added" End If ElseIf UCase(Target.Value) = "NO" Then With .Range("A4:A" & lastrow) Set rng = .Find(What:=Range("A" & Target.Row), _ LookIn:=xlValues, _ lookAt:=xlWhole, _ MatchCase:=False) If Not rng Is Nothing Then fAddr = rng.Address Do If rngToDel Is Nothing Then Set rngToDel = rng.Resize(, 5) Else Set rngToDel = Union(rngToDel, rng.Resize(, 5)) End If Set rng = .FindNext(rng) If rng Is Nothing Then Exit Do Loop While fAddr <> rng.Address End If If Not rngToDel Is Nothing Then rngToDel.Delete Shift:=xlUp MsgBox "Records from sheet2 removed" End If End With End If End With ExitHere: Application.EnableEvents = True Exit Sub ErrHandler: Resume ExitHere End Sub