多个工作表套用同一段vba代码 该怎么解决？

hhl3288

简单说一下比较容易明白，自己做了个客户销售记录的工作薄，工作薄中除了每个客户一个工作表，还有“主窗口”，“汇总”，“供货商”三个工作表。
问题：每个客户的工作表都有完全相同的vba代码，而且客户会增加，上百个，代码可能随时修改。如果每修改一次，就把代码复制粘贴上百次，是不是很笨很累啊？{:soso_e109:}


            怎么才能让除了“主窗口”，“汇总”，“供货商”这三个工作表，其它工作表都套用相同的vba代码啊？{:soso_e183:}

文档1.rar (28.48 KB, 下载次数: 54)

2013-6-29 10:05 上传

点击文件名下载附件

补充： 问题已经解决，在11楼新的附件里有代码。 感谢qy1219no2 提供的思路，感谢maditate 的热心帮助
代码如下：

Private Sub Worksheet_Change(ByVal Target As Range)
        '《自动计算总金额》
        Application.ScreenUpdating = False
        If Not Application.Intersect(Target, Union(Range("C3:d65536"), Range("j3:j65536"))) Is Nothing Then
                a = Target.Row
                If Range("C" & a).Value <> "" And Range("D" & a).Value <> "" Then
                        Range("E" & a) = Range("C" & a).Value * Range("D" & a).Value
                        Cells(a, 10).Select
                Else
                        Range("E" & a) = ""
                End If
                If Range("C" & a).Value <> "" And Range("D" & a).Value <> "" And Range("j" & a).Value <> "" Then
                        Range("k" & a) = (Range("d" & a).Value - Range("j" & a).Value) * Range("c" & a).Value
                        Range("l" & a) = 1 - Range("j" & a).Value / Range("d" & a).Value
                Else
                        Range("k" & a) = ""
                        Range("l" & a) = ""
                End If
        End If
        If Not Application.Intersect(Target, Range("g3:g65536")) Is Nothing Then
                a = Target.Row
                If Range("g" & a).Value <> "" Then
                        Range("h" & a) = Application.WorksheetFunction.Sum(Range(Cells(3, 5), Cells(a, 5))) - Application.WorksheetFunction.Sum(Range(Cells(3, 7), Cells(a, 7)))
                Else
                        Range("h" & a) = ""
                End If
        End If
        '《审核后保护行》
        ActiveSheet.Unprotect
        Cells.Locked = False
        For i = 3 To [a65536].End(xlUp).Row
                If Cells(i, 9) = "已审" Then
                        Range(Cells(i, 1), Cells(i, 8)).Locked = True
                        Range(Cells(i, 10), Cells(i, 12)).Locked = True
                Else
                        Range(Cells(i, 1), Cells(i, 8)).Locked = False
                        Range(Cells(i, 10), Cells(i, 12)).Locked = False
                End If
        Next
        ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
        ActiveSheet.EnableSelection = xlUnlockedCells
        '《审核列默认输入待审》
        If Target.Count > 1 Then Exit Sub     '异动单元格大于1跳出程序
        If Target.Column <> 1 Then Exit Sub        '异动非B栏单元格跳出程序
        If Target = "" Then     '异动B单元格空值
                Cells(Target.Row, 9) = ""
        Else
                Cells(Target.Row, 9) = "待审"
                ' Cells(Target.Row, 11) = ActiveSheet.Name
        End If
        Application.ScreenUpdating = True
End Sub
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
        '防止看错行
        If Target.Row >= 3 Then
                If Not (Application.CutCopyMode >= xlCopy) Then
                        ActiveSheet.Unprotect
                        Cells.Interior.ColorIndex = xlNone
                        Cells.Font.Bold = False
                        Range(Cells(Target.Row, 1), Cells(Target.Row, 12)).Interior.ColorIndex = 36
                        Range(Cells(Target.Row, 1), Cells(Target.Row, 16)).Font.Bold = True
                        ' Columns(Target.Column).Interior.ColorIndex = 35
                        Cells(Target.Row, Target.Column).Interior.ColorIndex = 44
                End If
        End If
        ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
End Sub

qy1219no2

把代码写成“模块”，每个工作表直接调用模块就OK了，需要修改，也只修改模块（一次）就OK了

yqdfd

楼主花花绿绿的颜色怎么弄出来的？

maditate

把代码放到 thisworkbook 里

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
myS = ActiveSheet.Name
If myS = "主窗口" Or myS = "供货商" Or myS = "汇总" Then Exit Sub

'你的具体代码

End Sub

hhl3288

你试试附件看看。我把代码写到模块里，总是报错。（私有事件已经改为公共事件了）。 另外写到thisworkbook里没有反应哦。参考这个帖子：

http://club.excelhome.net/forum. ... p;page=1#pid7030269

hhl3288

yqdfd 发表于 2013-6-29 10:13
楼主花花绿绿的颜色怎么弄出来的？

用的是这个链接的插件。
http://club.excelhome.net/thread-752823-1-1.html

hhl3288

maditate 发表于 2013-6-29 10:15
把代码放到 thisworkbook 里

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As R ...

这个办法我试过了，不起作用，不知道为什么。

maditate

hhl3288 发表于 2013-6-29 10:30
这个办法我试过了，不起作用，不知道为什么。

不可能不起作用，
每个事件都有自己的事件名。你不能把工作表事件直接搬进 thisworkbook.

hhl3288

maditate 发表于 2013-6-29 10:32
不可能不起作用，
每个事件都有自己的事件名。你不能把工作表事件直接搬进 thisworkbook.

那顶楼的代码应该怎么改才能放在thisworkbook里？

maditate

hhl3288 发表于 2013-6-29 12:30
那顶楼的代码应该怎么改才能放在thisworkbook里？

4楼已经给你具体的答案了，用4楼的事件名