从主工作表编辑工作表上的数据

Question

我有一个文件，包含5个数据相关表和一个额外的主表。这些主表具有一种功能，可根据ID将所有表中的数据检索到主表中。

现在代码的流程是：

Range().Select
Application.CutCopyMode = False
Selection.Copy
Sheets("mSheet").Select
ActiveSheet.Paste

它以一种简单的方式完成我想要的，它只显示必要的数据。我理想的是在这个数据和实际工作表之间建立链接，这样一旦我在主工作表中检索数据并执行任何编辑 - 这个编辑就在实际的相应工作表中进行。

任何想法和建议表示赞赏。

原始部分VBA代码：

Sheets("dSheet1").Select
ActiveSheet.ListObjects("Table").Range.AutoFilter Field:=3, Criteria1:=id
Range(Selection, Selection.End(xlDown)).Select
Range(Selection, Selection.End(xlToRight)).Select
Application.CutCopyMode = False
Selection.Copy

Sheets("masterSheet").Select
ActiveSheet.Paste Destination:=Sheets("masterSheet").Range("A8")

Answer 1

以下内容将复制您选择的内容，但不是粘贴该值将输入对单元格的引用，因此当单元格更新时，主工作表也将如此：

Sub foo()
Range("A1").Select
Sheets("mSheet").Range("A2").Formula = "=" & Selection.Address
End Sub

编辑

以下代码将与上面的代码相反，因此它将复制数据，将其粘贴到主工作表中，然后返回到原始复制范围并输入单元格引用，以便更新主数据时，该范围也是如此：

Sub foo()
Range("A1").Select 'select the range to be copied
Application.CutCopyMode = False
Selection.Copy 'copy it
Sheets("mSheet").Range("A2").PasteSpecial (xlPasteValues) 'paste the value into your master sheet
Range("A1").Formula = "=" & Sheets("mSheet").Range("A2").Address
'go back to your previous selection and enter the formula to reference the specific cell
End Sub

UPDATE

用以下内容替换代码，因为它使用相同的代码行，而没有任何Select语句：

Sub foo2()
Sheets("dSheet1").ListObjects("Table").Range.AutoFilter Field:=3, Criteria1:=ID
Sheets("dSheet1").Range("A2:D2").Copy Destination:=Sheets("masterSheet").Range("A8")
'change the range above to copy as many columns as you need
End Sub

然后在Master Sheet后面添加以下代码以检测更改：

Private Sub Worksheet_Change(ByVal Target As Range)
'place this code behing the masterSheet
LastRow = Sheets("dSheet1").Cells(Sheets("dSheet1").Rows.Count, "A").End(xlUp).Row
'get the last row of dSheet1
If Target.Address = "$A$8" Then 'if A8 changes
For i = 1 To LastRow 'loop through dSheet1 to find the ID
    If Sheets("dSheet1").Cells(i, 3) = Range("C8").Value Then 'when ID found
    Sheets("dSheet1").Cells(i, 1) = Range("A8").Value 'change relevant cell with new data
    End If
Next i
End If

'below do the same as above to change data for other columns, add more to adapt it to be able to make changes to however many columns you are copying over
If Target.Address = "$B$8" Then
For i = 1 To LastRow
    If Sheets("dSheet1").Cells(i, 3) = Range("C8").Value Then
    Sheets("dSheet1").Cells(i, 2) = Range("B8").Value
    End If
Next i
End If

If Target.Address = "$D$8" Then
For i = 1 To LastRow
    If Sheets("dSheet1").Cells(i, 3) = Range("C8").Value Then
    Sheets("dSheet1").Cells(i, 4) = Range("D8").Value
    End If
Next i
End If
End Sub

这假设您的ID是唯一的，并且您的自动过滤器会得到一行。

Answer 2

如何添加按钮。

CopyID - 从SheetID = B1复制范围

编辑后，EditID - 将清除SheetID = B1中的范围，并从A3的mSheet范围重写所有内容，然后粘贴到SheetID = B1

编辑ID代码：

Public Sub EditID(ID As String)
Sheets(ID).Select

If Range("A1").Value <> "" Then
Range("A1").Select
Range(Selection, Selection.End(xlToRight)).Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Clear
End If

Sheets("mSheet").Select

If Range("A3").Value <> "" Then
Range("A3").Select
Range(Selection, Selection.End(xlToRight)).Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy

Sheets(ID).Select
Range("A1").Select
ActiveSheet.Paste

End If

Sheets("msheet").Select

End Sub