0

我创建了一个包含多个工作表的工作簿，需要在同一工作簿内的不同工作表中使用大量双向链接单元格。因此，如果我在工作表 A 中编辑单元格 B5，它将自动将工作表 B 中的单元格 J2 更新为相同的值。相反，如果我更新工作表 B 中的单元格 J2，它将自动更新工作表 A 中的单元格 B5。为了完成双向链接，我在ThisWorkbook中包含了以下代码：

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
    If Sh.Name = "Smith,Joe" Then
        If Not Application.Intersect(Target, Range("B4")) Is Nothing Then
            Application.EnableEvents = False
            If Target.Parent.Name = "SomeProject" Then
                Sheets("Smith,Joe").Range("B4") = Target
            Else
                Sheets("SomeProject").Range("B10") = Target
            End If
            Application.EnableEvents = True
        End If
    End If
    If Sh.Name = "SomeProject" Then
        If Not Application.Intersect(Target, Range("B10")) Is Nothing Then
            Application.EnableEvents = False
            If Target.Parent.Name = "Smith,Joe" Then
                Sheets("SomeProject").Range("B10") = Target
            Else
                Sheets("Smith,Joe").Range("B4") = Target
            End If
            Application.EnableEvents = True
        End If
    End If
    If Sh.Name = "Smith,Joe" Then
        If Not Application.Intersect(Target, Range("C4")) Is Nothing Then
            Application.EnableEvents = False
            If Target.Parent.Name = "SomeProject" Then
                Sheets("Smith,Joe").Range("C4") = Target
            Else
                Sheets("SomeProject").Range("D10") = Target
            End If
            Application.EnableEvents = True
        End If
    End If
    If Sh.Name = "SomeProject" Then
        If Not Application.Intersect(Target, Range("D10")) Is Nothing Then
            Application.EnableEvents = False
            If Target.Parent.Name = "Smith,Joe" Then
                Sheets("SomeProject").Range("D10") = Target
            Else
                Sheets("Smith,Joe").Range("C4") = Target
            End If
            Application.EnableEvents = True
        End If
    End IF
    'This continues with for many different people/projects
End Sub

直到程序遇到 64k 限制（在论坛上找到了相关信息）之前，这都没有问题。为了解决这个限制，我创建了多个从主过程调用的单独过程，但单元格不再自动更新。在无数错误和无数论坛的访问之后，我最终在ThisWorkbook中使用WorkSheet_Change调用模块中的控制过程，并且所有工作表和单元格引用都作为变量传入。它仍然不再更新任一工作表上的单元格。就目前而言，当我单步执行 ChangeLogic 子中的模块代码时，我收到了运行时错误 91（对象变量或未设置块变量）。

本工作簿代码：

Option Explicit

Public Sh As Object
Public Target As Range
Public ResourceSheet As Object
Public ProjectSheet As Object
Public ResourceCell As String
Public ProjectCell As String

Private Sub Worksheet_Change(ByVal Sh As Object, ByVal Target As Range)

   Run "Main"

End Sub

“主”模块中的代码：

Sub Main()

    Call JoeMain

End Sub

Sub JoeMain()

    Set ResourceSheet = Sheets("Smith,Joe")
    Set ProjectSheet = Sheets("SomeProject")

    Call Joe1
    Call ChangeLogic(Sh, Target, ResourceSheet, ProjectSheet, ResourceCell, ProjectCell)

    Call Joe2
    Call ChangeLogic(Sh, Target, ResourceSheet, ProjectSheet, ResourceCell, ProjectCell)

    'Continues on for all cases involing Joe Smith.  I haven't gotten to iterating through project names as of yet

End Sub

Sub Joe1()

    ResourceCell = "B4"
    ProjectCell = "B10"

End Sub

Sub Joe2()

    ResourceCell = "C4"
    ProjectCell = "D10"

End Sub

Sub ChangeLogic(Sh, Target, ResourceSheet, ProjectSheet, ResourceCell, ProjectCell)
    If Sh.Name = ResourceSheet.Name Then
        If Not Application.Intersect(Target, Range(ResourceCell)) Is Nothing Then
            Application.EnableEvents = False
            If Target.Parent.Name = ProjectSheet.Name Then
                Sheets(ResourceSheet.Name).Range(ResourceCell) = Target
            Else
                Sheets(ProjectSheet.Name).Range(ProjectCell) = Target
            End If
            Application.EnableEvents = True
        End If
    End If
    If Sh.Name = ProjectSheet.Name Then
        If Not Application.Intersect(Target, Range(ProjectCell)) Is Nothing Then
            Application.EnableEvents = False
            If Target.Parent.Name = ResourceSheet.Name Then
            Sheets(ProjectSheet.Name).Range(ProjectCell) = Target
            Else
                Sheets(ResourceSheet.Name).Range(ResourceCell) = Target
            End If
            Application.EnableEvents = True
        End If
    End If
End Sub

在这一点上，我的新手颜色正在显示，我在我的头上。关于我做错了什么以及如何让它发挥作用的任何建议？

谢谢。

4

1 回答 1

1

我厌倦了输入评论，所以我不妨在这里输入并更清楚地说明我在说什么。

我不确定您是如何达到 64k 限制的。正如上面评论中提到的，您可以以更结构化/更紧凑的方式编写代码。目前您的代码是44不包括行的行Sub/End Sub/Comments相同的代码可以写成24行

所以直接节省了 20 行！！！.

Application.EnableEvents想象一下，当您删除所有不必要的/时，您的最终代码将减少多少IF-ENDIF

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
    On Error GoTo Whoa

    Application.EnableEvents = False

    Select Case Sh.Name
    Case "Smith,Joe"
        If Not Application.Intersect(Target, Range("B4")) Is Nothing Then _
        If Target.Parent.Name = "SomeProject" Then Sheets("Smith,Joe").Range("B4") = Target Else _
        Sheets("SomeProject").Range("B10") = Target

        If Not Application.Intersect(Target, Range("C4")) Is Nothing Then _
        If Target.Parent.Name = "SomeProject" Then Sheets("Smith,Joe").Range("C4") = Target Else _
        Sheets("SomeProject").Range("D10") = Target
    Case "SomeProject"
        If Not Application.Intersect(Target, Range("B10")) Is Nothing Then _
        If Target.Parent.Name = "Smith,Joe" Then Sheets("SomeProject").Range("B10") = Target Else _
        Sheets("Smith,Joe").Range("B4") = Target

        If Not Application.Intersect(Target, Range("D10")) Is Nothing Then _
        If Target.Parent.Name = "Smith,Joe" Then Sheets("SomeProject").Range("D10") = Target Else _
        Sheets("Smith,Joe").Range("C4") = Target

        'This continues with for many different people/projects
    End Select
LetsContinue:
    Application.EnableEvents = True
    Exit Sub
Whoa:
    MsgBox Err.Description
    Resume LetsContinue
End Sub
于 2013-11-08T17:10:04.827 回答