我想知道是否可以从另一个公共子调用私有Sub worksheet_Change(ByVal Target As Range)类型的sub?我知道你不能真正'调用'sub但运行它,但是我尝试运行sub似乎不起作用。这就是我的尝试:
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
我们非常感谢您提供有关如何解决问题的任何帮助或建议。
答案 0 :(得分:2)
Dim a As Workbook
Dim b As Workbook
Dim txt As String
Sub Button1_Click()
txt = InputBox("sheet name")
MsgBox txt
Set a = Workbooks.Open(Filename:="\\DESKTOP-E8QK413\Videos\target.xlsx.xlsx")
Set b = Workbooks("book1.xlsx")
a.Sheets(txt).Copy after:=b.Sheets(1)
a.Close
End Sub
会触发事件,但是粘贴应该已经完成了......
编辑:正如评论者指出的那样,您的代码还存在其他问题:这应该是您想要做的事情 -
With Sheets("Sheet2").Range("A65536").End(xlUp).Offset(1, 0)
.Value = .Value
End With
答案 1 :(得分:0)
您的代码存在一些问题。
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