Question

我创建了一个包含多个工作表的工作簿，需要在同一工作簿中的不同工作表中使用大量双向链接单元格。因此，如果我在工作表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限制（在论坛上发现了这个）。为了解决这个限制，我创建了一个从主proc调用的多个独立过程，但单元格不再自动更新。在无数错误和访问无数论坛之后，我最终在 ThisWorkbook 中调用了一个模块中的控制过程中的 WorkSheet_Change ，并且所有工作表和单元格引用都被传递了作为变量。它仍然不再更新任一工作表上的单元格。现在，当我逐步完成ChangeLogic子程序的模块代码时，我得到一个运行时错误91（对象变量或未设置块变量）。

ThisWorkbook 代码：

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

此时我的新手颜色正在显示，我正在我脑海中。对于我做错了什么以及如何让它发挥作用的任何建议？

感谢。

Answer 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

从Workbook_SheetChange中调用过程时出现问题

1 个答案: