Question

我想创建一个代码，将突出显示的单元格的内容从一个表格转移到另一个表格中与内容相同的表格，我使用按钮来复制内容，但我想创建一个宏来传输通过单击按钮动态显示内容，当用户更改第一个表中突出显示的单元格的内容时，内容会在第二个表格中自动更改，或者再次单击该按钮。

我使用此代码突出显示单元格

' Set of highlighted cells indexed by row number
Dim highlightedCells As New Collection

' Scan existing sheet for any cells coloured 'red' and initialise the
'  run-time collection of 'highlighted' cells.
Private Sub Worksheet_Activate()
   ActiveSheet.Unprotect Password:="P@ssw0rd"
    Dim existingHighlights As Range
    ' Reset the collection of highlighted cells ready to rebuild it
    Set highlightedCells = New Collection
    ' Find the first cell that has its background coloured red
    Application.FindFormat.Interior.ColorIndex = 3
    Set existingHighlights = ActiveSheet.Cells.Find("", _
                                                    LookIn:=xlValues, _
                                                    LookAt:=xlPart, _
                                                    SearchOrder:=xlByRows, _
                                                    SearchDirection:=xlNext, _
                                                    MatchCase:=False, _
                                                    SearchFormat:=True)
    ' Process for as long as we have more matches
    Do While Not existingHighlights Is Nothing
        cRow = existingHighlights.Row
        ' Add a reference only to the first coloured cell if multiple
        ' exist in a single row (will only occur if background manually set)
        Err.Clear
        On Error Resume Next
            Call highlightedCells.Add(existingHighlights.Address, CStr(cRow))
        On Error GoTo 0
        ' Search from the cell after the last match. Note an error in Excel
        '  appears to prevent the FindNext method from finding formats correctly
        Application.FindFormat.Interior.ColorIndex = 3
        Set existingHighlights = ActiveSheet.Cells.Find("", _
                                                    After:=existingHighlights, _
                                                    LookIn:=xlValues, _
                                                    LookAt:=xlPart, _
                                                    SearchOrder:=xlByRows, _
                                                    SearchDirection:=xlNext, _
                                                    MatchCase:=False, _
                                                    SearchFormat:=True)
        ' Abort the search if we've looped back to the top of the sheet
        If (existingHighlights.Row < cRow) Then
            Exit Do
        End If
    Loop

 ActiveSheet.Protect Password:="P@ssw0rd"
End Sub

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
    ActiveSheet.Unprotect Password:="P@ssw0rd"
    Dim hCell As String
    Dim cellAlreadyHighlighted As Boolean
    hCell = ""

    Err.Clear
    On Error Resume Next
      hCell = highlightedCells.Item(CStr(Target.Row))
    On Error GoTo 0

    If (hCell <> "") Then
        ActiveSheet.Range(hCell).Interior.ColorIndex = 2
        If (hCell = Target.Address) Then
            Call highlightedCells.Remove(CStr(Target.Row))
            Target.Interior.ColorIndex = 2
        Else
            Call highlightedCells.Remove(CStr(Target.Row))
            Call highlightedCells.Add(Target.Address, CStr(Target.Row))
            Target.Interior.ColorIndex = 3
        End If
    Else
        Err.Clear
        On Error Resume Next
          highlightedCells.Remove (CStr(Target.Row))
        On Error GoTo 0
        Call highlightedCells.Add(Target.Address, CStr(Target.Row))
        Target.Interior.ColorIndex = 3
    End If
    Cancel = True
      ActiveSheet.Protect Password:="P@ssw0rd"
End Sub

我使用此代码复制突出显示的单元格：

Sub CopyCat()
  ActiveSheet.Unprotect Password:="P@ssw0rd"
Dim LR As Long, i As Long, j As Long
Dim c As Range
j = 1
LR = Range("A" & Rows.Count).End(xlUp).Row
For Each c In Worksheets("MB").Range("A1:O" & LR)
      If c.Interior.ColorIndex = 3 Then
            c.Copy Destination:=Worksheets("MB").Range("J" & j)
        j = j + 1
        End If
Next c
  ActiveSheet.Protect Password:="P@ssw0rd"

End Sub

请帮助!!!!

Answer 1

不是复制整个表并使用值来填充第二页上的表，为什么不（对于那些要更新的项目，因为sheet1获取更新），只需留下一个＆＃34;链接＆＃34;回到原来的表。你可以将它按字面设置为它所引用的单元格，或者更健壮地使用像Index / Match这样的东西。见下文：

这是Sheet1（您要复制到第二张纸上的数据）的示例。我突出了＆＃34; Salary＆＃34;列，以反映用户被要求更改这些。

在表2中，您可以使用各种方式来链接＆＃34;回到第一张表：

这样，当你编辑Chris或John的薪水时，它会在第二张表中更新他们的薪水，而不需要运行任何宏。这是你正在寻找的事情，还是我忽视/误解了什么？

如何将Excel 2007中突出显示的单元格从一个表格传输到同一个工作表中的另一个表格？

1 个答案: