excel - 使用 vba 在 Excel 中强制设置单元格

Question

我已尝试使用此代码创建必填字段，但问题是它在进入单元格之前显示错误消息。

Private Sub Worksheet_SelectionChange(ByVal Target As Range)

    Dim lastRow As Long
    With ActiveSheet
        lastRow = .Cells(.Rows.count, "A").End(xlUp).Row
        Dim I, J As Integer
        For I = 1 To lastRow
        If Cells(I, "C").Value = "" Then
        MsgBox "Please Enter Business Type Value", vbOKOnly
        Exit Sub
        End If
        'If Cells(I, "D").Value = "" Then
        'MsgBox "Please Enter Customer Account Code", vbOKOnly
        'Exit Sub
        'End If
        'If Cells(I, "E").Value = "" Then
        'MsgBox "Please Enter Transport Mode Value", vbOKOnly
        'Exit Sub
        'End If
        'If Cells(I, "F").Value = "" Then
        'MsgBox "Please Enter Incoterm Value", vbOKOnly
        'Exit Sub
        'End If
        'If Cells(I, "K").Value = "" Then
        'MsgBox "Please Enter From date Value", vbOKOnly
        'Exit Sub
        'End If
        'If Cells(I, "L").Value = "" Then
        'MsgBox "Please Enter To date Value", vbOKOnly
        'Exit Sub
        'End If
        'If Cells(I, "K").Value > Cells(I, "L").Value Then
        'MsgBox "To date value should greater than From value", vbOKOnly
        'Exit Sub
        'End If
        'If Cells(I, "N").Value = "" Then
        'MsgBox "Please Enter Origin Country Code Value", vbOKOnly
        'Exit Sub
        'End If
        'If Cells(I, "O").Value = "" Then
        'MsgBox "Please Enter Point of Origin Location Code Value", vbOKOnly
        'Exit Sub
        'End If
        'If Cells(I, "R").Value = "" Then
        'MsgBox "Please Enter Port of Loading Code Value", vbOKOnly
        'Exit Sub
        'End If
        'If Cells(I, "S").Value = "" Then
        'MsgBox "Please Enter Origin Clearance Location Value", vbOKOnly
        'Exit Sub
        'End If
        'If Cells(I, "T").Value = "" Then
        'MsgBox "Please Enter Destination Clearance Location Value", vbOKOnly
        'Exit Sub
        'End If
        'If Cells(I, "U").Value = "" Then
        'MsgBox "Please Enter Port of Discharge Code Value", vbOKOnly
        'Exit Sub
        'End If
        If Cells(I, "Y").Value = "" Then
        MsgBox "Please Enter Consignee Final Destination Location Code Value", vbOKOnly
        Exit Sub
        End If
        If Cells(I, "Z").Value = "" Then
        MsgBox "Please Enter Destination Country Code Value", vbOKOnly
        Exit Sub
        End If
        If Cells(I, "AF").Value = "" Then
        MsgBox "Please Enter Active status Value", vbOKOnly
        Exit Sub
        End If
        If Cells(I, "AH").Value = "" Then
        MsgBox "Please Enter Carrier Allocation Number Value", vbOKOnly
        Exit Sub
        End If
        If Cells(I, "AI").Value = "" Then
        MsgBox "Please Enter  Carrier Allocation Valid From Date Value", vbOKOnly
        Exit Sub
        End If
        If Cells(I, "AJ").Value = "" Then
        MsgBox "Please Enter Carrier Nomination Sequence Number Value", vbOKOnly
        Exit Sub
        End If
        Next I
    End With

End Sub

Answer 1

这段代码

跟踪 A1:A10 以查看是否有任何单元格被更改

然后查看 Y 行中对应的单元格是否为空

如果为空，则返回一条消息，然后将 A1:A10 中已更改的单元格清空

代码

Private Sub Worksheet_Change(ByVal Target As Range)
Dim rng1 As Range
Dim rng2 As Range

Set rng1 = Intersect(Target, [a1:a10])
'exit if no cells in A1:A10 are changed
If rng1 Is Nothing Then Exit Sub

'turn off events to avoid code retriggering itself
Application.EnableEvents = False
For Each rng2 In rng1
    If Cells(rng2.Row, "Y") = vbNullString Then
       MsgBox "Please Enter Consignee Final Destination Location Code Value, your entry will be deleted", vbOKOnly
       rng2.Value = vbNullString
    End If
Next
Application.EnableEvents = True    
End Sub