每次在工作表1上添加范围时，excel会自动在工作表2上添加行

Question

表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.RemoveDuplicates功能：

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