☰

根据另一列的值强制列

tag-icon • tag-icon microsoft-excel vba macros validation
根据另一列的值强制列

我有一张包含以下列的 Excel 表 - A、B、C、D、E

如果 A 列已填满，则 D 列和 E 列为必填项。反之亦然，如果 D 列已填满，则 A 列和 E 列为必填项；如果 E 列已填满，则 A 列和 D 列为必填项。

我已经实现了代码，当用户在 A 列中输入任何值时，会抛出 D 列和 E 列的输入框。输入框中输入的值随后会设置为相应的列。我被困在反之亦然的部分。我希望当用户在 D 列或 E 列中输入值时发生同样的事情。请建议我如何在以下代码中做到这一点 -

       Private Sub Worksheet_Change(Byval Target As Range)
     If Target.Rows.Count > 1 Or     Target.Columns.Count > 1 Then 
     Exit Sub 
      End If
      Dim com As String 
      Dim comm1 As String 'Specify the range below. Set single column range else the code will error out 
       Set isect = Application.Intersect(Target, Range("A11:A200"))
       If isect Is Nothing Then
         Else If Target.Value <>0 Then    com = "Enter comment in " & Target.Offset(0, 3).Address(RowAbsolute:=False, columnabsolute:=False) 
         Do While comm1 = ""
          comm1 = Application.InputBox(prompt:=com, Type:=2) 
          On Error GoTo myloop If comm1 = False Then 
        comm1 = "" 
        End If 
        myloop: On Error GoTo -1 
         Loop 
          Target.Offset(0, 3).Value = comm1 
         

       comqty = "Enter comment in " & Target.Offset(0, 4).Address(RowAbsolute:=False, columnabsolute:=False) 
                   Do While qtycomm1 = ""
                    qtycomm1 = Application.InputBox(prompt:=comqty, Type:=2) 
                      On Error GoTo qtymyloop If qtycomm1 = False Then 
                    qtycomm1 = "" 
                   End If 
                  qtymyloop: On Error GoTo -1 
                   Loop 
                      Target.Offset(0, 4).Value = qtycomm1 



         End If   
         End If

答案1

展开代码，寻找与 D 列和 E 列的交点

Set isect = Application.Intersect(Target, Range("A11:A200"))
If Not isect Is Nothing Then
  'Do the column A checking stuff here
End If

Set isect = Application.Intersect(Target, Range("D11:D200"))
If Not isect Is Nothing Then
  'Do the column D checking stuff here
End If

Set isect = Application.Intersect(Target, Range("E11:E200"))
If Not isect Is Nothing Then
  'Do the column E checking stuff here
End If

更合乎逻辑的是，将拉'Do the column x checking stuff here入其自身Sub()可调用的，传递ByVal columnNumber As Long，然后使用columnNumber参数进行所有列检查。这样，您只需编写和维护一次此代码，而不必多次。

还请注意以下变化：

Set isect = Application.Intersect(Target, Range("A11:A200"))
If isect Is Nothing Then
  'implied do nothing here, but since there's no comment, maybe you were 
  'going to get to it later, so this is actually a bug
  'unfortunately, without a comment, this code structure makes it really hard to tell...
 Else
  'Do the column A checking stuff here
End If

到：

Set isect = Application.Intersect(Target, Range("A11:A200"))
If Not isect Is Nothing Then
  'Do the column A checking stuff here
End If

您可以明确地测试所追求的条件，从而无需通过注释来告知未来的程序员（包括未来的您）“此处故意留空”。

另外，我希望这只是将代码复制/粘贴到 SU 编辑器窗口中的产物，但缩进会使你的代码真的难以阅读。

如果你的实际代码是格式如此，我建议研究一下橡皮鸭 VBA一个免费的开源 VBE 插件，它将很多别的 特征，只需单击按钮即可将您的代码格式化为美观整洁。

*注：我是 RubberDuck 的忠实粉丝、常规用户，也是该项目的偶尔贡献者。

相关内容