excel自动添加表单2上的行每次添加表1的范围

表1是我们客户对我们现有的债务
而表2是我们公司的历史交易
有没有办法，所以如果每次在表格1中添加一行，它也将被添加到表格2上
但每次从表格1中删除一行，我不在表格2上
任何想法？

Private Sub Worksheet_Change(ByVal Target As Range) If Target = Range("A1") Then If Range("A1").Value <> Range("A2").Value Then Range("C1").Value = Range("C1").Value + 1 Range("A2").Value = Range("A1").Value End If End If End Sub 

我试了一下，但似乎并不正确

Answer 1

将代码连接到Worksheet_Change操作，而不是将其连接到Workbook_BeforeSave将是一个更好的状态。 在下面，当他或她保存工作簿时，提示用户立即更新交易表（ Sheet2 ）。 逻辑围绕复制所有债务（从Sheet1 ）到交易表，然后使用Excel内置的Range.RemoveDuplicatesfunction：

 Option Explicit Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean) Dim Choice As VbMsgBoxResult Dim LastRow As Long, LastCol As Long, _ LastTransRow As Long, ColIndex As Long Dim NewRange As Range, TargetRange As Range, _ FullTransRange As Range Dim DebtSheet As Worksheet, TransSheet As Worksheet Dim HeaderArray() As Variant 'prompt user to update the transactions on sheet2 Choice = MsgBox("Would you like to update the transactions sheet before saving?", _ vbYesNo, Title:="Update Transactions?") If Choice = vbYes Then 'set references up-front Set DebtSheet = ThisWorkbook.Worksheets("Sheet1") Set TransSheet = ThisWorkbook.Worksheets("Sheet2") With DebtSheet LastRow = .Cells.Find("*", SearchOrder:=xlByRows, _ SearchDirection:=xlPrevious).Row LastCol = .Cells.Find("*", SearchOrder:=xlByColumns, _ SearchDirection:=xlPrevious).Column End With Set NewRange = Range(DebtSheet.Cells(2, 1), DebtSheet.Cells(LastRow, LastCol)) 'copy all the debt info to the bottom of the transactions data block With TransSheet LastTransRow = .Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row Set TargetRange = Range(.Cells(LastTransRow + 1, 1), .Cells(LastTransRow + LastRow - 1, LastCol)) End With NewRange.Copy TargetRange 'apply excel's dupe-removal to the full range With TransSheet Set FullTransRange = Range(.Cells(1, 1), .Cells(LastTransRow + LastRow - 1, LastCol)) End With ReDim HeaderArray(0 To LastCol - 1) For ColIndex = 1 To LastCol HeaderArray(ColIndex - 1) = ColIndex Next ColIndex FullTransRange.RemoveDuplicates Columns:=HeaderArray, Header:=xlYes End If End Sub