繁体   English   中英

Excel宏,合并两个专用子工作表

[英]Excel Macro, Combining two Private Sub worksheet_change

我在此站点之前进行过搜索,但是在我的代码中找不到真正的案例。 希望这里有人可以帮助我。 下面如何合并两个私有子?

第一个代码

Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, Range("P:P")) Is Nothing Then Exit Sub
If Target.Count > 1 Then Exit Sub
If Target = "" Then Exit Sub
Dim NR As Long
With Application
  .EnableEvents = False
  .ScreenUpdating = False
  Select Case Target.Value
    Case "CLOSED"
      NR = Worksheets("Closed").Range("D1500").End(xlUp).Offset(1).Row
      Range("B" & Target.Row & ":P" & Target.Row).Copy Worksheets("Closed").Range("B" & NR)
      Rows(Target.Row).Delete
    Case "Re-handover"
      NR = Worksheets("Handover").Range("D1500").End(xlUp).Offset(1).Row
      Range("E" & Target.Row & ":O" & Target.Row).Copy Worksheets("Handover").Range("E" & NR)
      ' Rows(Target.Row).Delete
      End Select
  .EnableEvents = True
  .ScreenUpdating = True
End With
End Sub

第二码

Option Explicit
Public preValue As Variant

Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.Count > 1 Then Exit Sub
    If Target.Column <> 15 Then Exit Sub
    Target.ClearComments
Target.AddComment.Text Text:="Updated " & Format(Date, "dd mmm yyyy") & " " & Format(Time, "hh:mm") & Chr(10) & "By " & Environ("UserName")
End Sub

非常感谢你

这行得通吗?

Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Count > 1 Then Exit Sub

*If target.column=15 then
    Target.ClearComments
    Target.AddComment.Text Text:="Updated " & Format(Date, "dd mmm yyyy") & " " & Format(Time, "hh:mm") & Chr(10) & "By " & Environ("UserName")
else
endif *


If Intersect(Target, Range("P:P")) Is Nothing Then Exit Sub
If Target = "" Then Exit Sub
Dim NR As Long
With Application
  .EnableEvents = False
  .ScreenUpdating = False
  Select Case Target.Value
    Case "CLOSED"
      NR = Worksheets("Closed").Range("D1500").End(xlUp).Offset(1).Row
      Range("B" & Target.Row & ":P" & Target.Row).Copy Worksheets("Closed").Range("B" & NR)
      Rows(Target.Row).Delete
    Case "Re-handover"
      NR = Worksheets("Handover").Range("D1500").End(xlUp).Offset(1).Row
      Range("E" & Target.Row & ":O" & Target.Row).Copy Worksheets("Handover").Range("E" & NR)
      ' Rows(Target.Row).Delete
      End Select
  .EnableEvents = True
  .ScreenUpdating = True
End With
End Sub

暂无
暂无

声明:本站的技术帖子网页,遵循CC BY-SA 4.0协议,如果您需要转载,请注明本站网址或者原文地址。任何问题请咨询:yoyou2525@163.com.

 
粤ICP备18138465号  © 2020-2024 STACKOOM.COM