如果我的Sheet1中有如下代码

-z-

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
    If Range(Target.Address).Columns.Count > 1 Or Range(Target.Address).Rows.Count > 1 Then Exit Sub
    If Target = "W01" Then
    Range(Target.Address).Interior.ColorIndex = 3
    ElseIf Target = "W02" Then
    Range(Target.Address).Interior.ColorIndex = 4
    Else
    Range(Target.Address).Interior.ColorIndex = 0
    End If
End Sub
我如何在Sheet2中也使用这段代码？或者我可以把这段代码放入模块中，如果是这样，那么我如何调用模块中的这段代码呢？

AVEL

如果sheet2跟sheet1结构一样，想实现功能也一样，那么直接复制上面的代码到sheet2里面就好了。

-z-

AVEL 发表于 2011-9-5 02:57
如果sheet2跟sheet1结构一样，想实现功能也一样，那么直接复制上面的代码到sheet2里面就好了。

可不可以些在模块里，然后调用。

hhl3288

同问啊。如果有几百个工作表，每改动一次代码就复制粘贴一次，那多麻烦啊。。。

大灰狼1976

可以写在模块内调用，注意TARGET需要改成ACTIVECELL，
但是每个工作表内必须要写入调用的过程

sheet1

把下面代码放入到thisworkbook中试试
Private Sub Workbook_SheetBeforeDoubleClick(ByVal Sh As Object, ByVal Target As Range, Cancel As Boolean)
你的代码
End Sub

hhl3288

楼上的两位的办法都试过了，大灰狼1976 的办法总是报错，sheet1 的办法没反应。不知道怎么回事。代码是：

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

大灰狼1976

这个代码跟最初的代码完全没有可比性，建议上传附件
而且我估计你对什么叫写到模块里这句话完全不明白

-z-

大灰狼1976 发表于 2013-6-29 10:40
这个代码跟最初的代码完全没有可比性，建议上传附件
而且我估计你对什么叫写到模块里这句话完全不明白

哦，是啊，我真的是不很清楚。

大灰狼1976

那就上传附件吧{:soso_e100:}