Если Range содержит ячейку со значением> 8, то MsgBox

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

Событие изменения рабочего листа сверхурочных

Код

Модуль 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

Лист1 (или любой другой, который вы используете)

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 2

Вы можете использовать событие Worksheet_Change в VBA для автоматического запуска кода при изменении чего-либо на листе.Скопируйте следующий код на лист в редакторе Visual Basic.

Private Sub Worksheet_Change(ByVal Target As Range)

If Target.Row >= 14 And Target.Row <= 26 And Target.Value > 8 Then
    If Target.Column = 6 Then
        MsgBox ("Wurde der Mehraufwand der Arbeitszeit mit dem Teamlead abgesprochen?")
    ElseIf Target.Column >= 7 And Target.Column <= 11 Then
        MsgBox ("Wurde der Mehraufwand der Arbeitszeit abgesprochen?")
    End If
End If

End Sub

Этот код запускается всякий раз, когда вы что-то меняете на листе.Код проверяет, находятся ли измененные ячейки между 14-й и 26-й строками, если значение измененной ячейки больше 8, если ячейки находятся между указанными столбцами и т. Д.

Answer 3

Range("F14,F26").Value возвращает значение только F14, полностью игнорируя F26.

. Вот как построить событие с помощью msgbox для 1 ячейки:

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 4

Вам необходимо написать следующий код на уровне рабочего листа (щелкните правой кнопкой мыши имя листа, просмотрите код и вставьте следующий код:

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 5

Вы можете попробовать:

Следуйте инструкциям на изображении:

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