☰

撤消更改，并在 ActiveSheet 中加上 msgbox 如果另一个工作表中的范围小于下面的单元格

tag-icon • tag-icon microsoft-excel vba
撤消更改，并在 ActiveSheet 中加上 msgbox 如果另一个工作表中的范围小于下面的单元格

在("Menu")范围内，C15:C25我输入了反映在工作表("Pack Plan")范围内的值B5:P5，并进行了一些计算，然后在("Pack Plan")范围内B6:P6我有其他计算值。我需要一个代码来撤消("Menu")范围内的任何更改C15:C25，并且如果该更改导致范围MsgBox "Adjust Pack Plan"内任何单元格的值小于正下方单元格的值。目前我有 15 个 IF 来执行此操作。我需要一个 IF 参数，它将允许添加更多条件，而不必为每个 IF 重复它们。 是活动工作表。("Pack Plan")B5:P5("Menu")

在对类似问题的回答中，我没有看到任何有效的方法。

谢谢。

Private Sub Worksheet_Change(ByVal Target As Range)
    Application.EnableEvents = False
        If (Target.Column = 5) Then

'I'm trying to consolidate the following IF arguments into 2 set's of IF code instead of having IF's for each cell in range.
'First these two If's:

            If Worksheets("Crème").Range("C11").Value > Worksheets("Pack Plan").Range("B5").Value Then
                MsgBox "Missing Ingredient!"
                Application.Undo
            End If
            If Worksheets("Crème").Range("C12").Value > Worksheets("Pack Plan").Range("I5").Value Then
                MsgBox "Missing Ingredient!"
                Application.Undo
            End If
            
'Then the following 15 IF's:

            If Worksheets("Pack Plan").Range("B5").Value < Worksheets("Pack Plan").Range("B6").Value Then
                MsgBox "Adjust Packout Plan"
                Application.Undo
            End If
            If Worksheets("Pack Plan").Range("C5").Value < Worksheets("Pack Plan").Range("C6").Value Then
                MsgBox "Adjust Packout Plan"
                Application.Undo
            End If
            If Worksheets("Pack Plan").Range("D5").Value < Worksheets("Pack Plan").Range("D6").Value Then
                MsgBox "Adjust Packout Plan"
                Application.Undo
            End If
            If Worksheets("Pack Plan").Range("E5").Value < Worksheets("Pack Plan").Range("E6").Value Then
                MsgBox "Adjust Packout Plan"
                Application.Undo
            End If
            If Worksheets("Pack Plan").Range("F5").Value < Worksheets("Pack Plan").Range("F6").Value Then
                MsgBox "Adjust Packout Plan"
                Application.Undo
            End If
            If Worksheets("Pack Plan").Range("G5").Value < Worksheets("Pack Plan").Range("G6").Value Then
                MsgBox "Adjust Packout Plan"
                Application.Undo
            End If
            If Worksheets("Pack Plan").Range("H5").Value < Worksheets("Pack Plan").Range("H6").Value Then
                MsgBox "Adjust Packout Plan"
                Application.Undo
            End If
            If Worksheets("Pack Plan").Range("I5").Value < Worksheets("Pack Plan").Range("I6").Value Then
                MsgBox "Adjust Packout Plan"
                Application.Undo
            End If
            If Worksheets("Pack Plan").Range("J5").Value < Worksheets("Pack Plan").Range("J6").Value Then
                MsgBox "Adjust Packout Plan"
                Application.Undo
            End If
            If Worksheets("Pack Plan").Range("K5").Value < Worksheets("Pack Plan").Range("K6").Value Then
                MsgBox "Adjust Packout Plan"
                Application.Undo
            End If
            If Worksheets("Pack Plan").Range("L5").Value < Worksheets("Pack Plan").Range("L6").Value Then
                MsgBox "Adjust Packout Plan"
                Application.Undo
            End If
            If Worksheets("Pack Plan").Range("M5").Value < Worksheets("Pack Plan").Range("M6").Value Then
                MsgBox "Adjust Packout Plan"
                Application.Undo
            End If
            If Worksheets("Pack Plan").Range("N5").Value < Worksheets("Pack Plan").Range("N6").Value Then
                MsgBox "Adjust Packout Plan"
                Application.Undo
            End If
            If Worksheets("Pack Plan").Range("O5").Value < Worksheets("Pack Plan").Range("O6").Value Then
                MsgBox "Adjust Packout Plan"
                Application.Undo
            End If
            If Worksheets("Pack Plan").Range("P5").Value < Worksheets("Pack Plan").Range("P6").Value Then
                MsgBox "Adjust Packout Plan"
                Application.Undo
            End If
        End If
        
' code to be consolidated ends here

        If (Target.Column = 3) Then
            If (Target.Offset(0, 2)) <> "" Then
                Application.Undo
                MsgBox "Clear Batch Size First", vbExclamation, "RESTRICTED"
            End If
        End If
    Application.EnableEvents = True
End Sub

答案1

最简单的方法是在编码之前命名范围。即使你不这样做：

Dim oTest as Range

For Each oTest in Worksheets("Pack Plan").Range("B5:P5").Cells
    If oTest.Value2 < oTest.Offset(1,0).Value2 Then
        ...
        Exit For ' So you don't repeat the message box needlessly
    End If
Next oTest

Set oTest=Nothing

使用命名范围（例如，“Pack Plan”第 5 行的“CalculatedValues”），您的代码简化为：

Dim oTest as Range

For Each oTest in [CalculatedValues].Cells
    If ...
    ...
    End If
Next oTest
Set oTest=Nothing

与您的“缺失成分”测试类似的概念。

相关内容