再一个工作表格两个Change事件代码，怎么合并？

小年玩卡

第一个：
Private Sub Worksheet_Change(ByVal Target As Range)
    Dim c As Range
    Application.EnableEvents = False
    If Not Intersect(Target, Range("b6:b52,b54:b100,b102:b148,b150:b196,b198:b244,b246:b292,b295:b340,b342:b388,b390:b436,b438:b484,b486:b532,b534:b580")) Is Nothing Then '第二列6行开始，52行结束
        For Each c In Intersect(Target, Range("b6:b52,b54:b100,b102:b148,b150:b196,b198:b244,b246:b292,b295:b340,b342:b388,b390:b436,b438:b484,b486:b532,b534:b580")) '当复制数据块粘贴进来，依然有效！
            If Len(c) Then c.Offset(, -1) = Now '有数据时才填入日期
        Next
        End If
        If Not Intersect(Target, Range("h6:h52,h54:h100,h102:h148,h150:h196,h198:h244,h246:h292,h295:h340,h342:h388,h390:h436,h438:h484,h486:h532,h534:h580")) Is Nothing Then '第二列6行开始，52行结束
        For Each c In Intersect(Target, Range("h6:h52,h54:h100,h102:h148,h150:h196,h198:h244,h246:h292,h295:h340,h342:h388,h390:h436,h438:h484,h486:h532,h534:h580")) '当复制数据块粘贴进来，依然有效！
            If Len(c) Then c.Offset(, 2) = Now
            Next
        End If
        If Not Intersect(Target, Range("m7:m9,m11:m13,m55:m57,m59:m61,m103:m105,m107:m109,m151:m153,m155:m157,m199:m201,m203:m205,m247:m249,m251:m253,m295:m297,m299:m301,m343:m345,m347:m349,m391:m393,m395:m397,m439:m441,m443:m445,m487:m489,m490:m493,m535:m537,m539:m541")) Is Nothing Then '第二列6行开始，52行结束
        For Each c In Intersect(Target, Range("m7:m9,m11:m13,m55:m57,m59:m61,m103:m105,m107:m109,m151:m153,m155:m157,m199:m201,m203:m205,m247:m249,m251:m253,m295:m297,m299:m301,m343:m345,m347:m349,m391:m393,m395:m397,m439:m441,m443:m445,m487:m489,m490:m493,m535:m537,m539:m541")) '当复制数据块粘贴进来，依然有效！
            If Len(c) Then c.Offset(, 1) = Now
            Next
        End If
    Application.EnableEvents = True
End Sub


第二个：
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Count <> 1 Then Exit Sub
    If Target.Column <> 5 Then Exit Sub
    If Target.Row = 5 Then Exit Sub
    If Len(Target) <> 4 Then Exit Sub
    With Sheets("mcc")
        Set Rng = .Columns(1).Find(Target.Value, lookat:=xlWhole)
        If Not Rng Is Nothing Then
            Application.EnableEvents = False
                Cells(Target.Row, 15) = Rng.Offset(0, 1)
                Cells(Target.Row, 16) = Rng.Offset(0, 3)
                Cells(Target.Row, 17) = Rng.Offset(0, 5)
            Application.EnableEvents = True
        End If
    End With

End Sub

把第二个放到第一个里面  第二个不能触发
模板2.rar (87 KB, 下载次数: 3)

2018-10-5 20:21 上传

点击文件名下载附件

liulang0808

楼主最好上传附件，并结合实际应用来描述需求
初步看，可以将第二部分的代码放在第一个end sub前
关键看能不能满足需求

小年玩卡

liulang0808 发表于 2018-10-5 19:53
楼主最好上传附件，并结合实际应用来描述需求
初步看，可以将第二部分的代码放在第一个end sub前
关键看 ...

放过，但是都没有用了