Question

我有一个用于输入数据和运行计算的表。这个表有很多列，所以我为可打印的输出创建了第二个表。两个表中的第一列是两个表共有的唯一值，因此输出表基本上是一个表，它使用查找函数从每行的输入表中提取所需的数据或结果。

在最终用户添加和删除输入表中的行时，使两个表中的第一列始终相同的最佳方法是什么？我一直试图计算一个宏，这样每次将值添加到输入的第一列时，该值都会被复制到输出表的第一列的最后一行，但是我不会＃39 ; t知道如果删除行，或者添加了重复值，它将如何工作。或者我可以使用一个宏，每次更改输入列时都会复制并粘贴整个列。我还缺少哪些明显的解决方案我还应该考虑？我对VBA很新，但是一旦我弄清楚哪个方向会让最终用户最简单，我想我能够弄明白。

更新：对于遇到类似问题的其他人来说，这是我最后写的代码，到目前为止效果很好。在工作表中：

Private Sub Worksheet_Change(ByVal Target As Range)

Dim KeyCells As Range
Set KeyCells = Range("A:A")

If Not Application.Intersect(KeyCells, Range(Target.Address)) Is Nothing Then

    Call Module1.UpdateOutput

End If


End Sub

在第1单元中：

Sub UpdateOutput()

' UpdateOutput Macro

'Set active cell for return at end of macro
Dim ActCell As Range
Set ActCell = Selection

' Check Input table has data
If Sheet6.ListObjects("Input").DataBodyRange Is Nothing Then
Exit Sub
End If

'Count Selected Rows of Input and Output Table
Dim RowsIn As Long
RowsIn = Sheet6.ListObjects("Input").ListColumns("UWI").DataBodyRange.Rows.Count
Dim RowsOut As Long
RowsOut = Sheet3.ListObjects("Results").DataBodyRange.Rows.Count
Dim RowsCalc As Long
RowsCalc = Sheet1.ListObjects("IWCP").DataBodyRange.Rows.Count

Application.ScreenUpdating = False
'Delete extra rows from Output Table
Dim lRow As Long
lRow = RowsOut + 1
Do While lRow >= RowsIn + 2
Sheet3.Rows(lRow).Delete
Sheet1.Rows(lRow + 1).Delete
lRow = lRow - 1
Loop

'Select UWI column from input table
Application.Goto Sheet6.ListObjects("Input").ListColumns("UWI").DataBodyRange
Selection.Copy

'Paste UWI column from input table
Sheet3.ListObjects("Results").ListColumns("UWI").DataBodyRange(1).PasteSpecial xlPasteValues
Sheet1.ListObjects("IWCP").ListColumns("UWI").DataBodyRange(1).PasteSpecial xlPasteValues
Application.CutCopyMode = False

'Return to previous cell
Application.Goto ActCell
Application.ScreenUpdating = True

End Sub

Answer 1

我假设你的两个表都在Sheet1中。您必须在与Sheet1相对应的模块中插入以下代码

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim rngsrc As Range, rngtrg As Range
    Dim losrc As ListObject, lotrg As ListObject
    Set losrc = Me.ListObjects(1)
    Set lotrg = Me.ListObjects(2)
    'Set rngsrc = your_source_range_to_monitor
    Set rngsrc = losrc.ListColumns(1).Range
    Set rngtrg = lotrg.ListColumns(1).Range

    Dim ints As Range
    Set ints = Application.Intersect(rngsrc, Target)
    If (Not (ints Is Nothing)) Then
        ' Do your job to copy from rngsrc to rngtrg
        Application.CutCopyMode = xlCopy
        rngsrc.Copy
        rngtrg.PasteSpecial Paste:=xlPasteFormulas, Operation:=xlPasteSpecialOperationNone
    End If
End Sub

并根据需要进行修改。

两个具有一个相同列的excel表，可以从另一个自动更新吗？

1 个答案: