0

同じブック内の異なるワークシートに多数の双方向リンク セルを必要とする複数のシートを含むブックを作成しました。したがって、worksheetA のセル B5 を編集すると、worksheetB のセル 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 (オブジェクト変数または With ブロック変数が設定されていません) が発生します。

このワークブックコード:

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 に答える