超时工作表更改事件

Question

我正在编写时间记录表。如果一个工作日的值大于8（超过8小时）被填写。我希望弹出一个消息框。

我正在努力处理当前使用的代码。

如果在填充单元格时宏会自动运行，那也很好。

非常感谢有关解决此问题的任何想法。

Sub GenehmigungMehrarbeit()

   If Range("F14,F26").Value > 8 Then
        MsgBox ("Wurde der Mehraufwand der Arbeitszeit mit dem Teamlead abgesprochen?")

   If Range("G14,G26").Value > 8 Then
        MsgBox ("Wurde der Mehraufwand der Arbeitszeit abgesprochen?")

    ElseIf Range("H14,H26").Value > 8 Then
        MsgBox ("Wurde der Mehraufwand der Arbeitszeit abgesprochen?")

    ElseIf Range("I14,I26").Value > 8 Then
        MsgBox ("Wurde der Mehraufwand der Arbeitszeit  abgesprochen?")

    ElseIf Range("J14,J26").Value > 8 Then
        MsgBox ("Wurde der Mehraufwand der Arbeitszeit abgesprochen?")

  End If
Exit Sub
End Sub

Answer 1

您需要在工作表级别编写以下代码（右键单击工作表名称，查看代码并粘贴以下代码：

Private Sub Worksheet_Change(ByVal Target As Range)
    If Not Application.Intersect(Target, Range("F14:J26")) Is Nothing Then
            If Target.Value > 8 Then
                MsgBox "You entered 8+ hours!!"
                Target.Value = ""
                Target.Select
            End If
    End If
End Sub

Answer 2

超时工作表更改事件

代码

模块1 （或您正在使用的任何模块）

Option Explicit

Sub GenehmigungMehrarbeit(Worksheet As Worksheet)  ' Overtime

    ' List of Check Range Addresses
    Const cRanges As String = "F14:F26,G14:G26,H14:H26,I14:I26,J14:J26"
    ' German List of Days
    Const cDays As String = "Montag,Dienstag,Mittwoch,Donnerstag,Freitag"
    ' Message 1
    Const strMsg1 = "Wurde der Mehraufwand der Arbeitszeit für den "
    ' Message 2
    Const strMsg2 = " mit dem Teamlead abgesprochen?"
    Const cHours As Long = 8  ' Hours

    Dim vntR As Variant   ' Check Range Array
    Dim vntD As Variant   ' Days Array
    Dim i As Long         ' Ranges/Days Array Elements Counter

    ' Split List of Range Addresses to Check Range Array
    vntR = Split(cRanges, ",")
    ' Split German List of Days to Days Array
    vntD = Split(cDays, ",")

    ' In This workbook's Worksheet
    With ThisWorkbook.Worksheets(Worksheet.Name)
        ' Loop through elements of Check Range Array (Days Array).
        For i = 0 To UBound(vntR)
            ' Check if sum of the current Check Range is greater than cHours.
            If WorksheetFunction.Sum(.Range(Trim(vntR(i))).Value) _
                    > cHours Then
                ' Build the (daily) message.
                MsgBox strMsg1 & Trim(vntD(i)) & strMsg2, vbInformation, vntD(i)
                Exit For ' Stop checking.
                ' Note: The message box will pop up only for the first found
                '       range with the sum greater than Hours (cHours).
                '       If you want the messages to pop up for every range
                '       with the sum greater than Hours, you should out
                '       comment the previous line.
            End If
        Next
    End With

End Sub

Sheet1 （或您正在使用的任何内容）

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
    If Not Application.Intersect(Target, Range("F14:J26")) Is Nothing Then _
            GenehmigungMehrarbeit Me
End Sub

Answer 3

您可以尝试：

按照图片上的说明进行操作：

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)

    Dim rng1 As Range, rng2 As Range, rng3 As Range, rng4 As Range, rng5 As Range

        Set rng1 = Range("F14,F26")
        Set rng2 = Range("G14,G26")
        Set rng3 = Range("H14,H26")
        Set rng4 = Range("I14,I26")
        Set rng5 = Range("J14,J26")

        If Not Intersect(Target, rng1) Is Nothing Or Not Intersect(Target, rng2) Is Nothing _
            Or Not Intersect(Target, rng3) Is Nothing Or Not Intersect(Target, rng4) Is Nothing _
            Or Not Intersect(Target, rng5) Is Nothing Then _

            If Target.Value > 8 Then
                If Not Intersect(Target, rng1) Is Nothing Then
                    MsgBox ("Wurde der Mehraufwand der Arbeitszeit mit dem Teamlead abgesprochen?")
                Else
                    MsgBox ("Wurde der Mehraufwand der Arbeitszeit abgesprochen?")
                End If
            End If

        End If

End Sub

Answer 4

Range("F14,F26").Value仅返回F14的值，而完全忽略了F26。

这是使用1个单元格的msgbox构建事件的方法：

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)

    If Intersect(Target, Range("F14")) Is Nothing Then Exit Sub
    If Range("F14") > 8 Then
        MsgBox "Something in German"
    End If

End Sub

将以上代码放在相应的工作表中，而不是在模块中：

Answer 5

您可以在VBA中使用Worksheet_Change事件在工作表中进行某些更改时自动运行代码。将以下代码复制到Visual Basic编辑器中的工作表中。

df.rename(columns={"is_open_x":"is_open_df1","is_open_y":"is_open_df2"})

只要您更改工作表中的某些内容，此代码就会运行。代码检查更改后的单元格是否在第14到26行之间，更改后的单元格的值是否大于8，是否在指定列之间，等等。

如果范围包含值大于8的单元格，则MsgBox

5 个答案:

超时工作表更改事件

代码