简体   繁体   English

将单个工作表的Excel VBA转换为工作簿范围

[英]Converting Excel VBA for a single sheet to workbook wide

I have the following VBA code that functions properly when put in the code sheet for a single worksheet within an Excel workbook: 我将以下VBA代码放入Excel工作簿中单个工作表的代码表中时可以正常运行:

Private Sub Worksheet_Change(ByVal Target As Range)

    Application.EnableEvents = False

    If Not Intersect(Range("E:E"), Target) Is Nothing Then
        Target = Int(Target) + (Target - Int(Target)) * 100 / 60
    End If

    Application.EnableEvents = True

End Sub

I want to change the code so that I can put it in the workbook code sheet rather than the code sheet of each individual worksheet, and to do so came up with the following that I thought would function. 我想更改代码,以便可以将其放在工作簿代码表中,而不是每个工作表的代码表中,并提出以下我认为可以起作用的内容。 However, it does not. 但是,事实并非如此。

Private Sub Workbook_Change(ByVal Sh As Object, ByVal Target As Range)

    ' Do nothing if not entering data in time cell
    If (Intersect(Target, Sh.Range("F:F")) Is Nothing) Then Exit Sub

    Application.EnableEvents = False

    Dim ws As Worksheet
    Dim sheets As Variant: sheets = Array("January", "February", "March", "April", "May", "June", "July", "August", "September", "October", "November", "December")
    Dim sheet As Variant     

    For Each sheet In sheets
        Set ws = ThisWorkbook.Worksheets(ActiveSheet)
        If Not Intersect(ws.Range("F:F"), Target) Is Nothing Then
            Target = Int(Target) + (Target - Int(Target)) * 100 / 60
        End If
        If Int(Target) = 0 Then
            Target.ClearContents
        End If
    Next

Application.EnableEvents = True

End Sub

Is there an obvious error there so that I can be pointed in the correct direction? 是否有明显的错误,以便我可以指向正确的方向?

Put this in your ThisWorkbook Code: 将其放在您的ThisWorkbook代码中:

    Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
Dim hr As Boolean
Dim sheets As Variant: sheets = Array("January", "February", "March", "April", "May", "June", "July", "August", "September", "October", "November", "December")
Dim sheet As Variant
On Error GoTo ext
For Each sheet In sheets
    If sheet = Sh.Name Then
        hr = True
    End If
Next sheet

If Not Intersect(Sh.Range("F:F"), Target) Is Nothing And hr Then
    Application.EnableEvents = False
    Target = Int(Target) + (Target - Int(Target)) * 100 / 60
    If Int(Target) = 0 Then
        Target.ClearContents
    End If
End If
Application.EnableEvents = True
Exit Sub
ext:
Application.EnableEvents = True
End Sub

I believe this will do what you were trying. 我相信这会做您想要的。

Edit: 编辑:

As per @RBarryYoung, it was also missing the error check to ensure that it turns back on the Events. 根据@RBarryYoung,它也丢失了错误检查以确保重新打开事件。

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

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