如何同步两个单元格？答案

【问题标题】：How to synchronize two cells?如何同步两个单元格？
【发布时间】：2020-11-10 13:21:35
【问题描述】：

我的代码应该使某些单元格与另一张纸上的相应单元格保持同步。

如果我更改B2000TBES，即“Kalkylsammanställning”表上的单元格 I29，它应该更改 B2000TBES，即“B2000”表上的单元格 H195。

整个代码。（几行基本上什么都不做，因为这是粘贴在工作表后面。）

Private Sub Worksheet_Change(ByVal Target As Range)

Dim htCell1 As Range
Dim htCell2 As Range
Dim htCell3 As Range
Dim htCell4 As Range
Dim htCell5 As Range
Dim htCell6 As Range

Dim hCell1 As Range
Dim hCell2 As Range
Dim hCell3 As Range
Dim hCell4 As Range
Dim hCell5 As Range
Dim hCell6 As Range
Dim hCell7 As Range
Dim hCell8 As Range
Dim hCell9 As Range
Dim hCell10 As Range

Dim rCell1 As Range
Dim rCell2 As Range
Dim rCell3 As Range
Dim rCell4 As Range
Dim rCell5 As Range
Dim rCell6 As Range
Dim rCell7 As Range
Dim rCell8 As Range
Dim rCell9 As Range
Dim rCell10 As Range

Dim peCell1 As Range
Dim peCell2 As Range
Dim peCell3 As Range
Dim peCell4 As Range
Dim peCell5 As Range
Dim peCell6 As Range
Dim peCell7 As Range
Dim peCell8 As Range
Dim peCell9 As Range
Dim peCell10 As Range

Dim paCell1 As Range
Dim paCell2 As Range
Dim paCell3 As Range
Dim paCell4 As Range
Dim paCell5 As Range
Dim paCell6 As Range
Dim paCell7 As Range
Dim paCell8 As Range
Dim paCell9 As Range
Dim paCell10 As Range

Dim speCell1 As Range
Dim speCell2 As Range
Dim speCell3 As Range
Dim speCell4 As Range
Dim speCell5 As Range
Dim speCell6 As Range
Dim speCell7 As Range
Dim speCell8 As Range
Dim speCell9 As Range
Dim speCell10 As Range

Dim spaCell1 As Range
Dim spaCell2 As Range
Dim spaCell3 As Range
Dim spaCell4 As Range
Dim spaCell5 As Range
Dim spaCell6 As Range
Dim spaCell7 As Range
Dim spaCell8 As Range
Dim spaCell9 As Range
Dim spaCell10 As Range

Dim varRanta As Range

If Target.Count > 1 Then Exit Sub

Set htCell1 = ActiveWorkbook.Sheets("Kalkylsammanställning").Range("HTIDS")
Set htCell2 = ActiveWorkbook.Sheets("S3000").Range("S3000HTID")
Set htCell3 = ActiveWorkbook.Sheets("S2000").Range("S2000HTID")
Set htCell4 = ActiveWorkbook.Sheets("K2000").Range("K2000HTID")
Set htCell5 = ActiveWorkbook.Sheets("B2000").Range("B2000HTID")
Set htCell6 = ActiveWorkbook.Sheets("K10").Range("K10HTID")

Set hCell1 = ActiveWorkbook.Sheets("Kalkylsammanställning").Range("S3000HYRAS")
Set hCell2 = ActiveWorkbook.Sheets("S3000").Range("S3000HYRA")
Set hCell3 = ActiveWorkbook.Sheets("Kalkylsammanställning").Range("S2000HYRAS")
Set hCell4 = ActiveWorkbook.Sheets("S2000").Range("S2000HYRA")
Set hCell5 = ActiveWorkbook.Sheets("Kalkylsammanställning").Range("K2000HYRAS")
Set hCell6 = ActiveWorkbook.Sheets("K2000").Range("K2000HYRA")
Set hCell7 = ActiveWorkbook.Sheets("Kalkylsammanställning").Range("B2000HYRAS")
Set hCell8 = ActiveWorkbook.Sheets("B2000").Range("B2000HYRA")
Set hCell9 = ActiveWorkbook.Sheets("Kalkylsammanställning").Range("K10HYRAS")
Set hCell10 = ActiveWorkbook.Sheets("K10").Range("K10HYRA")

Set rCell1 = ActiveWorkbook.Sheets("Kalkylsammanställning").Range("S3000FAKTORS")
Set rCell2 = ActiveWorkbook.Sheets("S3000").Range("S3000FAKTOR")
Set rCell3 = ActiveWorkbook.Sheets("Kalkylsammanställning").Range("S2000FAKTORS")
Set rCell4 = ActiveWorkbook.Sheets("S2000").Range("S2000FAKTOR")
Set rCell5 = ActiveWorkbook.Sheets("Kalkylsammanställning").Range("K2000FAKTORS")
Set rCell6 = ActiveWorkbook.Sheets("K2000").Range("K2000FAKTOR")
Set rCell7 = ActiveWorkbook.Sheets("Kalkylsammanställning").Range("B2000FAKTORS")
Set rCell8 = ActiveWorkbook.Sheets("B2000").Range("B2000FAKTOR")
Set rCell9 = ActiveWorkbook.Sheets("Kalkylsammanställning").Range("K10FAKTORS")
Set rCell10 = ActiveWorkbook.Sheets("K10").Range("K10FAKTOR")

Set peCell1 = ActiveWorkbook.Sheets("Kalkylsammanställning").Range("S3000TBES")
Set peCell2 = ActiveWorkbook.Sheets("S3000").Range("S3000TBE")
Set peCell3 = ActiveWorkbook.Sheets("Kalkylsammanställning").Range("S2000TBES")
Set peCell4 = ActiveWorkbook.Sheets("S2000").Range("S2000TBE")
Set peCell5 = ActiveWorkbook.Sheets("Kalkylsammanställning").Range("K2000TBES")
Set peCell6 = ActiveWorkbook.Sheets("K2000").Range("K2000TBE")
Set peCell7 = ActiveWorkbook.Sheets("Kalkylsammanställning").Range("B2000TBES")
Set peCell8 = ActiveWorkbook.Sheets("B2000").Range("B2000TBE")
Set peCell9 = ActiveWorkbook.Sheets("Kalkylsammanställning").Range("K10TBES")
Set peCell10 = ActiveWorkbook.Sheets("K10").Range("K10TBE")

Set paCell1 = ActiveWorkbook.Sheets("Kalkylsammanställning").Range("S3000TBAS")
Set paCell2 = ActiveWorkbook.Sheets("S3000").Range("S3000TBA")
Set paCell3 = ActiveWorkbook.Sheets("Kalkylsammanställning").Range("S2000TBAS")
Set paCell4 = ActiveWorkbook.Sheets("S2000").Range("S2000TBA")
Set paCell5 = ActiveWorkbook.Sheets("Kalkylsammanställning").Range("K2000TBAS")
Set paCell6 = ActiveWorkbook.Sheets("K2000").Range("K2000TBA")
Set paCell7 = ActiveWorkbook.Sheets("Kalkylsammanställning").Range("B2000TBAS")
Set paCell8 = ActiveWorkbook.Sheets("B2000").Range("B2000TBA")
Set paCell9 = ActiveWorkbook.Sheets("Kalkylsammanställning").Range("K10TBAS")
Set paCell10 = ActiveWorkbook.Sheets("K10").Range("K10TBA")

Set speCell1 = ActiveWorkbook.Sheets("Kalkylsammanställning").Range("S3000SPES")
Set speCell2 = ActiveWorkbook.Sheets("S3000").Range("S3000SPE")
Set speCell3 = ActiveWorkbook.Sheets("Kalkylsammanställning").Range("S2000SPES")
Set speCell4 = ActiveWorkbook.Sheets("S2000").Range("S2000SPE")
Set speCell5 = ActiveWorkbook.Sheets("Kalkylsammanställning").Range("K2000SPES")
Set speCell6 = ActiveWorkbook.Sheets("K2000").Range("K2000SPE")
Set speCell7 = ActiveWorkbook.Sheets("Kalkylsammanställning").Range("B2000SPES")
Set speCell8 = ActiveWorkbook.Sheets("B2000").Range("B2000SPE")
Set speCell9 = ActiveWorkbook.Sheets("Kalkylsammanställning").Range("K10SPES")
Set speCell10 = ActiveWorkbook.Sheets("K10").Range("K10SPE")

Set spaCell1 = ActiveWorkbook.Sheets("Kalkylsammanställning").Range("S3000SPAS")
Set spaCell2 = ActiveWorkbook.Sheets("S3000").Range("S3000SPA")
Set spaCell3 = ActiveWorkbook.Sheets("Kalkylsammanställning").Range("S2000SPAS")
Set spaCell4 = ActiveWorkbook.Sheets("S2000").Range("S2000SPA")
Set spaCell5 = ActiveWorkbook.Sheets("Kalkylsammanställning").Range("K2000SPAS")
Set spaCell6 = ActiveWorkbook.Sheets("K2000").Range("K2000SPA")
Set spaCell7 = ActiveWorkbook.Sheets("Kalkylsammanställning").Range("B2000SPAS")
Set spaCell8 = ActiveWorkbook.Sheets("B2000").Range("B2000SPA")
Set spaCell9 = ActiveWorkbook.Sheets("Kalkylsammanställning").Range("K10SPAS")
Set spaCell10 = ActiveWorkbook.Sheets("K10").Range("K10SPA")

Set varRanta = ActiveWorkbook.Sheets("Kalkylsammanställning").Range("RANTAVAR")


Application.EnableEvents = False

Select Case Target.Address

Case varRanta.Address
Call Sum_Hyra

Case htCell1.Address
htCell2.Value = htCell1.Value
htCell3.Value = htCell1.Value
htCell4.Value = htCell1.Value
htCell5.Value = htCell1.Value
htCell6.Value = htCell1.Value

Case hCell1.Address
hCell2.Value = hCell1.Value
Case hCell2.Address
hCell1.Value = hCell2.Value
Case hCell3.Address
hCell4.Value = hCell3.Value
Case hCell4.Address
hCell3.Value = hCell4.Value
Case hCell5.Address
hCell6.Value = hCell5.Value
Case hCell6.Address
hCell5.Value = hCell6.Value
Case hCell7.Address
hCell8.Value = hCell7.Value
Case hCell8.Address
hCell7.Value = hCell8.Value
Case hCell9.Address
hCell10.Value = hCell9.Value
Case hCell10.Address
hCell9.Value = hCell10.Value

Case rCell1.Address
rCell2.Value = rCell1.Value
Call Sum_Hyra
Case rCell2.Address
rCell1.Value = rCell2.Value
Call Sum_Hyra
Case rCell3.Address
rCell4.Value = rCell3.Value
Call Sum_Hyra
Case rCell4.Address
rCell3.Value = rCell4.Value
Call Sum_Hyra
Case rCell5.Address
rCell6.Value = rCell5.Value
Call Sum_Hyra
Case rCell6.Address
rCell5.Value = rCell6.Value
Call Sum_Hyra
Case rCell7.Address
rCell8.Value = rCell7.Value
Call Sum_Hyra
Case rCell8.Address
rCell7.Value = rCell8.Value
Call Sum_Hyra
Case rCell9.Address
rCell10.Value = rCell9.Value
Call Sum_Hyra
Case rCell10.Address
rCell9.Value = rCell10.Value
Call Sum_Hyra

Case peCell1.Address
peCell2.Value = peCell1.Value
Case peCell2.Address
peCell1.Value = peCell2.Value
Case peCell3.Address
peCell4.Value = peCell3.Value
Case peCell4.Address
peCell3.Value = peCell4.Value
Case peCell5.Address
peCell6.Value = peCell5.Value
Case peCell6.Address
peCell5.Value = peCell6.Value
Case peCell7.Address
peCell8.Value = peCell7.Value
Case peCell8.Address
peCell7.Value = peCell8.Value
Case peCell9.Address
peCell10.Value = peCell9.Value
Case peCell10.Address
peCell9.Value = peCell10.Value

Case paCell1.Address
paCell2.Value = paCell1.Value
Case paCell2.Address
paCell1.Value = paCell2.Value
Case paCell3.Address
paCell4.Value = paCell3.Value
Case paCell4.Address
paCell3.Value = paCell4.Value
Case paCell5.Address
paCell6.Value = paCell5.Value
Case paCell6.Address
paCell5.Value = paCell6.Value
Case paCell7.Address
paCell8.Value = paCell7.Value
Case paCell8.Address
paCell7.Value = paCell8.Value
Case paCell9.Address
paCell10.Value = paCell9.Value
Case paCell10.Address
paCell9.Value = paCell10.Value

Case speCell1.Address
speCell2.Value = speCell1.Value
Case speCell2.Address
speCell1.Value = speCell2.Value
Case speCell3.Address
speCell4.Value = speCell3.Value
Case speCell4.Address
speCell3.Value = speCell4.Value
Case speCell5.Address
speCell6.Value = speCell5.Value
Case speCell6.Address
speCell5.Value = speCell6.Value
Case speCell7.Address
speCell8.Value = speCell7.Value
Case speCell8.Address
speCell7.Value = speCell8.Value
Case speCell9.Address
speCell10.Value = speCell9.Value
Case speCell10.Address
speCell9.Value = speCell10.Value

Case spaCell1.Address
spaCell2.Value = spaCell1.Value
Case spaCell2.Address
spaCell1.Value = spaCell2.Value
Case spaCell3.Address
spaCell4.Value = spaCell3.Value
Case spaCell4.Address
spaCell3.Value = spaCell4.Value
Case spaCell5.Address
spaCell6.Value = spaCell5.Value
Case spaCell6.Address
spaCell5.Value = spaCell6.Value
Case spaCell7.Address
spaCell8.Value = spaCell7.Value
Case spaCell8.Address
spaCell7.Value = spaCell8.Value
Case spaCell9.Address
spaCell10.Value = spaCell9.Value
Case spaCell10.Address
spaCell9.Value = spaCell10.Value

End Select

Application.EnableEvents = True
End Sub

一切正常，除了 B2000TBES 更改时 peCell8.Value 不会更改为 peCell7.Value。

我使用了“Step Into”，代码识别了单元格及其值。

我仔细检查了代码中的每个字母和符号。

当我删除除此特定操作的代码之外的所有内容时，它会起作用：

Private Sub Worksheet_Change(ByVal Target As Range)

Dim peCell7 As Range
Dim peCell8 As Range

If Target.Count > 1 Then Exit Sub

Set peCell7 = ActiveWorkbook.Sheets("Kalkylsammanställning").Range("B2000TBES")
Set peCell8 = ActiveWorkbook.Sheets("B2000").Range("B2000TBE")

Application.EnableEvents = False
Select Case Target.Address

Case peCell7.Address
peCell8.Value = peCell7.Value

End Select

Application.EnableEvents = True

End Sub

澄清一下：
长代码做它应该做的，除了改变peCell8.Value。
短代码有效。

【问题讨论】：

它不起作用，因为您的代码是一团乱七八糟的意大利面条代码并且极难维护（抱歉）。此外，此代码仅在仅更改一个单元格时才会同步。例如，如果您复制/粘贴一个范围，它不会同步，并且您最终会在您认为它们相同的地方得到不同的值。我强烈建议将数据和代码分开。数据将是应保持同步的工作表/范围地址列表。将此列表放入隐藏表中，并使用该隐藏表中的信息使您的代码精简。因此，您无需修改代码即可轻松添加新的同步范围。
进一步，每当您感觉需要为变量名称编号时，您就做错了。这是一个非常糟糕的做法。始终使用数组而不是编号的变量名称，这样您至少可以循环遍历它们，而不是一遍又一遍地重复代码。
实际上不能用公式代替那个代码吗？例如，您可以使用 =Sheet2!B3 使任何单元格的值与 Sheet2 中的 B3 相同
感谢您的评论 Pᴇʜ。这段代码一开始只是一个很小的代码，但在那之后多次请求了更多相同类型的功能，因此出现了这个凌乱的意大利面条。复制和粘贴范围的问题不会是问题，只是不是如何使用工作表。我什至会如何使用数组呢？混乱的代码与它为什么不起作用无关，因为其他所有操作都有效。只是不是那个特别的。
我希望能够在两个单元格中进行更改并确保相应的单元格同步。

标签： excel vba

【解决方案1】：

创建一个名为 SyncTable 的（隐藏）工作表，如下所示：

_{图 1：SyncTable 显示应在哪些更改上执行同步。}

确保名称 SyncA、SyncB 等存在于您的工作簿范围的任何工作表中（功能区 › 公式 › 名称管理器 › 列“范围”需要为这些名称的 Workbook）。

_{图 2：“Arbeitsmappe”= 工作簿。所有名称都需要在工作簿范围内。}

以下代码需要（仅一次）放入ThisWorkbook 范围：

Option Explicit

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
    
    If Target.Cells.Count > 1 Then Exit Sub
    
    Application.EnableEvents = False
    On Error GoTo SAVE_EXIT
    
    Dim CellName As String
    CellName = vbNullString 'initialize
    
    'check if cell has a name
    On Error Resume Next
    CellName = Target.Name.Name
    On Error GoTo SAVE_EXIT
    
    If CellName <> vbNullString Then
        'check if cell should be synced to …
        Dim SyncTo As Variant
        SyncTo = Application.VLookup(CellName, Worksheets("SyncTable").Range("A:B"), 2, 0)
        
        If Not IsError(SyncTo) Then
            Dim Destination As Range
            Set Destination = Nothing 'initialize
            
            'check if sync to destination names exist
            On Error Resume Next
            Set Destination = Range(SyncTo)
            On Error GoTo SAVE_EXIT
            
            If Not Destination Is Nothing Then
                'names exist so sync
                Range(SyncTo).Value = Target.Value
            Else
                MsgBox "Named range '" & SyncTo & "' could not be found, check names", vbCritical
            End If
        End If
    End If

    
SAVE_EXIT: 'make sure you never end up with disabled events
    Application.EnableEvents = True
    If Err.Number <> 0 Then Err.Raise Err.Number, Err.Source, Err.Description, Err.HelpFile, Err.HelpContext
End Sub

然后最后得到如下所示的命名范围（注意它们都在一个工作表中，但这只是为了说明目的，它们可以在不同的工作表中）。

_{图 3：这里的同步完全按照 SyncTable 中的定义执行。}

这样你就有了一个干净的短代码和一个可以轻松扩展的 SyncTable。您只需添加您的姓名，例如 B2000TBES 和 B2000TBE。如果您想在两个方向上同步，则必须以相反的方式添加它们B2000TBE 和B2000TBES。如果您想将一个单元格同步到多个单元格中，请将它们以逗号分隔，就像第一个条目一样。

请注意，您不能使用普通单元格地址，这仅适用于命名范围。

【讨论】：

感谢您的详尽解释。我确信这可以正常工作，如果我开始一个新项目，我将改为遵循此程序。但由于我 99% 的代码都能正常工作，而且实际上还有 25 个其他单元格与每个基础工作表上的相应单元格配对，没有任何问题，我希望能快速解决这个问题。但我不希望有人像你所说的那样梳理我的“凌乱的意大利面”；）我会将这个答案标记为已解决。再次感谢您的意见！