從公共子調用（運行）私有子worksheet_Change（ByVal目標為范圍）

Question

我想知道是否可以從另一個公共子對象中調用子類型的私有Sub worksheet_Change（ByVal Target As Range）類型嗎？ 我知道您不能真正地“調用”該子程序，但是運行它，但是我嘗試運行該子程序的嘗試似乎沒有用。 這是我嘗試過的：

Sub AccessTransfer()
Range("A1:F1").Select
Selection.Copy
Sheets("Sheet2").Select
ActiveSheet.Paste
ActiveCell.Offset(0, 6).Value = "Oven"
Range("A65536").End(xlUp).Offset(1, 0).Select
Run.Application "Private Sub Worksheet_Change(ByVal Target As Range)"

Sheets("Sheet1").Select

Application.CutCopyMode = False

End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
If Application.CountIf(Range("A:A"), Target) > 1 Then
    MsgBox "Duplicate Entry", vbCritical, "Remove Data"
    Target.Value = ""
End If
Range("A65536").End(xlUp).Offset(1, 0).Select
End Sub

任何有關如何解決我的問題的幫助或建議，將不勝感激。

Answer 1

With Sheets("Sheet2").Range("A65536").End(xlUp).Offset(1, 0)
    .Value = .Value
End With

將觸發事件，但是粘貼操作應該已經完成​​了...

編輯 ：正如評論者所指出的那樣，您的代碼還有其他問題：這應該類似於您想要做的事情-

Sub AccessTransfer()

    Dim shtSrc As Worksheet, shtDest As Worksheet
    Dim v, c As Range

    Set shtSrc = ActiveSheet
    Set shtDest = ThisWorkbook.Sheets("Sheet2")

    v = shtSrc.Range("A1").Value  'value to check...

    If Application.CountIf(shtDest.Range("A:A"), v) > 0 Then
        MsgBox "Value '" & v & "' already exists!", vbCritical, "Can't Transfer!"
    Else
       'OK to copy over...
       Set c = shtDest.Range("A65536").End(xlUp).Offset(1, 0)
       shtSrc.Range("A1:F1").Copy c
       c.Offset(0, 6).Value = "oven"
    End If

    Application.CutCopyMode = False

End Sub

Answer 2

您的代碼有幾處錯誤。

• 您可能正在Worksheet_Change中進行更改（例如Target.Value =“”），這將觸發另一個事件。
• 您尚未將Target隔離到A列，也沒有處理超過一個作為Target的單元格。

Module1代碼表：

Sub AccessTransfer()
    With Worksheets("Sheet2")
        Worksheets("Sheet1").Range("A1:F1").Copy _
            Destination:=.Cells(.Rows.Count, "A").End(xlUp).Offset(1, 0)
        'Sheet2's Worksheet_Change has been triggered right here

        'check if the action has been reversed
        If Not IsEmpty(.Cells(.Rows.Count, "A").End(xlUp)) Then
            'turn off events for the Oven value write
            Application.EnableEvents = False
            .Cells(.Rows.Count, "A").End(xlUp).Offset(0, 6) = "Oven"
            'turn events back on
            Application.EnableEvents = True
        End If
    End With
End Sub

Sheet2代碼表：

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
    If Not Intersect(Target, Range("A:A")) Is Nothing Then
        On Error GoTo bm_Safe_Exit
        Application.EnableEvents = False
        Dim c As Long, rngs As Range
        Set rngs = Intersect(Target, Range("A:A"))
        For c = rngs.Count To 1 Step -1
            If Application.CountIf(Columns("A"), rngs(c)) > 1 Then
                MsgBox "Duplicate Entry in " & rngs(c).Address(0, 0), _
                    vbCritical, "Remove Data"
                rngs(c).EntireRow.Delete
            End If
        Next c
    End If
bm_Safe_Exit:
    Application.EnableEvents = True
End Sub