4

在 excel 中,我想在不同的工作表中链接 2 个单独的单元格以具有完全相同的格式。如果第一个单元格发生更改,我还需要第二个单元格自动更新。

这可能吗?

非常感谢。

4

2 回答 2

0

下面的 VBA 代码将完成这项工作。

在这里你可以检查找到一个例子:

https://github.com/thanosa/excel-vba-collection/tree/master/link_formatted_cells

您必须指定:

  1. 源工作表名称
  2. 目标工作表名称(可以相同)
  3. 源 ID 列
  4. 来源信息栏
  5. 目标 ID 列
  6. 目的地信息栏

它的作用是:

  1. 从目标表中读取目标 ID
  2. 在源表中查找目标 ID 以查找行
  3. 根据上面找到的行和源信息列从源表中复制单元格
  4. 将单元格按原样粘贴到当前行和目标信息列的目标工作表中。
Const MAX_ROWS = 1000000

Private Sub CopyFormatted()
    ' Looks-up the destination id into the source look-up column to retrieve the row number
    ' Then it copies the source cell into the destination cell
    ' This is done to copy the format and the within cell new lines

    ' Layout dependent for the Destination
    dstWsName = "sheet1"
    dstFirstRow = 2
    dstIdCol = "A"
    dstWriteCol = "B"

    ' Layout dependent for the Source
    srcWsName = "sheet1"
    srcFirstRow = 2
    srcLookupCol = "D"
    srcReadCol = "E"

    Call performancePre

    Call lookUpCell(dstWsName, dstFirstRow, dstIdCol, dstWriteCol, _
                    srcWsName, srcFirstRow, srcLookupCol, srcReadCol)

    Call performancePost

End Sub


Private Sub lookUpCell(dstWsName, dstFirstRow, dstIdCol, dstWriteCol, _
                       srcWsName, srcFirstRow, srcLookupCol, srcReadCol)
    ' Reads a value in

    Dim srcWs As Worksheet
    Dim dstWs As Worksheet

    Set srcWs = ActiveWorkbook.Sheets(srcWsName)
    Set dstWs = ActiveWorkbook.Sheets(dstWsName)

    Dim sourceIdsVector As Range
    Set sourceIdsVector = srcWs.Range(srcLookupCol & srcFirstRow & ":" & srcLookupCol & MAX_ROWS)

    ' Initialization
    dstWriteRow = dstFirstRow
    Do
        srcRow = Empty
        searchId = dstWs.Range(dstIdCol & dstWriteRow).Value

        ' Make sure the id is not empty
        If searchId = vbNullString Then Exit Do

        ' Lookup the id to find the row number
        For Each cell In sourceIdsVector.Cells
            If cell.Value = "" Then Exit For

            If cell.Value = searchId Then
                srcRow = cell.Row
                Exit For
            End If
        Next cell

        ' If the search succeeds id does the copy paste of the cells.
        If srcRow <> Empty Then

            Dim srcCell As Range
            Set srcCell = srcWs.Range(srcReadCol & srcRow)

            Dim dstCell As Range
            Set dstCell = dstWs.Range(dstWriteCol & dstWriteRow)

            Call CopyPasteRange(srcWs, srcCell, dstWs, dstCell)

        End If

        ' Update
        dstWriteRow = dstWriteRow + 1
    Loop

End Sub


Private Sub CopyPasteRange(srcWs As Worksheet, srcRange As Range, dstWs As Worksheet, dstRange As Range)
    ' Copy a ranges and pastes it to another
    srcWs.Select
    srcRange.Select
    Selection.Copy

    dstWs.Select
    dstRange.Select
    ActiveSheet.Paste

    Application.CutCopyMode = False

End Sub


Private Sub performancePre()
    Application.ScreenUpdating = False
    Application.DisplayStatusBar = False
    Application.Calculation = xlCalculationManual
    Application.EnableEvents = False
    ActiveSheet.DisplayPageBreaks = False 'note this is a sheet-level setting
End Sub


Private Sub performancePost()
    Application.ScreenUpdating = True
    Application.DisplayStatusBar = True
    Application.Calculation = xlCalculationAutomatic
    Application.EnableEvents = True
    ActiveSheet.DisplayPageBreaks = True 'note this is a sheet-level setting
End Sub
于 2020-01-25T17:59:12.427 回答
-1

尝试使用 =sheetname!Cellref 例如,如果您需要您的单元格与价格中的单元格 g4 相同,您会说 =Prices!G4

或者,如果这不起作用,请打开两张纸,在正在复制的单元格中键入 =,然后轻弹到另一本书并单击您希望它复制的单元格 =]

于 2012-08-23T13:34:13.077 回答