从同一工作簿中的特定工作表运行宏

时间:2017-08-29 10:24:11

标签: excel vba excel-vba

如果我把它放在sheet1中,下面的宏可以正常工作。但是我想把这个宏放在sheet2中。不幸的是,它不能从Sheet2开始,只能从Sheet1开始。你能帮我把它从Sheet2运行吗?

Private Sub Worksheet_Change(ByVal Target As Range)
Dim rng As Range
Dim sRes As Variant
On Error GoTo haveError

Set rng = Application.Intersect(Sheet1.Range("I15:I18"), Target)


If Not rng Is Nothing Then
    If rng.Cells.count = 1 Then
        sRes = Application.VLookup(rng.Value, _
               Sheet2.Range("A56:B58"), 2, True)
        'turn off events before updating the worksheet
        Application.EnableEvents = False
        rng.Offset(0, 1).Value = IIf(IsError(sRes), "???", sRes)
        Select Case rng.Offset(0, 1).Value
            Case "Low Risk": rng.Offset(0, 2).Value = Date + 180

            Case "Medium Risk": rng.Offset(0, 2).Value = Date + 150

            Case "High Risk": rng.Offset(0, 2).Value = Date + 120

        End Select
        Application.EnableEvents = True
    End If '<< edit added missing line here
End If
Exit Sub

haveError:
Application.EnableEvents = True '<< ensures events are reset
End Sub

1 个答案:

答案 0 :(得分:0)

这个问题的答案比我想象的要简单:

Private Sub Worksheet_Change(ByVal Target As Range)
Dim rng As Range
Dim rng1 As Range

Dim sRes As Variant
Dim sRes1 As Variant
On Error GoTo haveError

Set rng = Application.Intersect(Sheet1.Range("I15:I18"), Target)
Set rng1 = Application.Intersect(Sheet1.Range("I20:I23"), Target)
If Not rng Is Nothing Then
    If rng.Cells.count = 1 Then
        sRes = Application.VLookup(rng.Value, _
               Sheet2.Range("A56:B58"), 2, True) 'Waterlow
        'turn off events before updating the worksheet
        Application.EnableEvents = False
        rng.Offset(0, 1).Value = IIf(IsError(sRes), "???", sRes)
        Select Case rng.Offset(0, 1).Value
            Case "Low Risk": rng.Offset(0, 2).Value =  Date + 180
            Case "Medium Risk": rng.Offset(0, 2).Value = Date + 150      
            Case "High Risk": rng.Offset(0, 2).Value = Date + 120

        End Select
        Application.EnableEvents = True
    End If '<< edit added missing line here

ElseIf Not rng1 Is Nothing Then
If rng1.Cells.count = 1 Then
        sRes1 = Application.VLookup(rng1.Value, _
               Sheet3.Range("A28:B30"), 2, True) 'MUST
        'turn off events before updating the worksheet
        Application.EnableEvents = False
        rng1.Offset(0, 1).Value = IIf(IsError(sRes1), "???", sRes1)
        Select Case rng1.Offset(0, 1).Value
            Case "Low Risk": rng1.Offset(0, 2).Value = Date + 180
            Case "Medium Risk": rng1.Offset(0, 2).Value = Date + 150
            Case "High Risk": rng1.Offset(0, 2).Value = Date + 120

        End Select
        Application.EnableEvents = True
    End If '<< edit added missing line here
   End If
Exit Sub

haveError:
Application.EnableEvents = True '<< ensures events are reset
End Sub

结合两个程序只是一个问题。一个简单的Elseif使它运行(工作:))宏。 感谢大家帮助我。