Question

我正在尝试编写一个基本上可以实现的代码，以便如果将任何数据添加到我的工作簿中任何表的第3列中，但没有将数据添加到第4列中，则将出现一个输入框并提示用户输入所需的数据。我已经能够找到所需的点点滴滴，但无法将引用结构化表中列的解决方案组合在一起。以下是我的代码最佳尝试。我不知道为什么它不起作用，因为我绝对不是VBA专家（但！）。考虑到这一点，请保持温柔。任何和所有帮助表示赞赏！谢谢！

请注意，这将添加到较大的子集中。我所有的人都工作正常。

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
    Dim t As ListObjects
    Dim Pos As ListColumns
    myOCC As Variant

    For Each t In ActiveSheet.ListObjects
        If Not Intersect(Target, PosD.ListColumns(3).DataBodyRange) Is Nothing Then
            Exit Sub
        ElseIf Not Intersect(Target, PosD.ListColumns(3).DataBodyRange) <> 0 Then
            myOCC = InputBox("OCC Code Required. Please Enter Valid OCC Code")

            Application.EnableEvents = False
            Cells(Target.Row, "C").Value = General
            Application.EnableEvents = True

            Exit Sub
        End If
    Next t
End Sub

Answer 1

如果第四列没有值，则每次用户对任何工作表上的列表对象的第三列进行更改时，以下代码都会强制输入框。这可能是绝对确保输入值的最快和最简单的方法。

Option Explicit

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

    If isCellInListObject(Target) Then

        Dim lo As ListObject
        Set lo = Sh.ListObjects(Target.ListObject.Name)

        If Not Intersect(lo.DataBodyRange.Columns(3), Target) Is Nothing Then

            If Target.Offset(, 1) = vbNullString Then

                Dim occ As Variant
                occ = InputBox("OCC Code Required. Please Enter Valid OCC Code")

                Target.Offset(, 1) = occ

            End If

        End If

    End If

End Sub


Function isCellInListObject(whichCell As Range) As Boolean

    Dim test As Boolean

    On Error Resume Next 'used because a cell not in a list object will produce an error (but test will result in false)
    test = whichCell.ListObject.Name <> ""
    On Error GoTo 0

    isCellInListObject = test

End Function

必填数据输入框

1 个答案: