VBA - 是否可以根据条件自动弹出错误信息？
VBA - Is it possible to have an error message that automatically pops-up based on condition?
如果用户填写序列号。 col B中的列（不一定是全部10个，只要填一个即可），他们需要填写col C到col F的其他列。因此，如果 col B 已填满但 col C to F 中的任何单元格未填满，我希望弹出一条错误消息。我希望下面的图片能给你一个更清晰的想法..:[=21=]
我不确定 Worksheet_SelectionChange 是否会完成我想要完成的...因为我不想包含命令按钮。因为一些用户可能不愿意点击命令按钮来验证他们的输入。这是我目前的代码，请随时提出相应的建议....谢谢:)
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Range("B4").Value = "" Then
MsgBox "serial no. is a Mandatory field", vbExclamation, "Required Entry"
Range("B4").Select
End If
If Range("B4:B") <> "" Then
If Range("C4:C").Value = "" Then
MsgBox "Product is a Mandatory field", vbExclamation, "Required Entry"
Range("C4:C").Select
End If
' Adding values from sheet 2 for fruits drop-down list.
If Not Intersect(Target, Range("D3")) Is Nothing Then
Sheets("Sheet1").Range("D3") = "[Please Select]"
Dim col As New Collection
Dim rng As Range
Dim i As Long
Dim dvlist As String
'Loop thru the data range
For Each rng In Sheet2.Range("B2:B7")
'ignore blanks
If Len(Trim(rng.Value)) <> 0 Then
'create a unique list
On Error Resume Next
col.Add rng.Value, CStr(rng.Value)
On Error GoTo 0
End If
Next rng
'concatenate with "," as the delimiter
For i = 2 To col.Count
dvlist = dvlist & col.Item(i) & ","
Next i
With Sheet1.Range("C2:C").Validation
.Delete
.Add Type:=xlValidateList, _
AlertStyle:=xlValidAlertStop, _
Formula1:=dvlist
End With
End If
' Adding values from sheet 2 for country of origin drop-down list.
If Not Intersect(Target, Range("E4")) Is Nothing Then
Sheets("Screening Request").Range("E4") = "[Please Select]"
'Loop thru the data range
For Each rng In Sheet2.Range("A2:A7")
'ignore blanks
If Len(Trim(rng.Value)) <> 0 Then
'create a unique list
On Error Resume Next
col.Add rng.Value, CStr(rng.Value)
On Error GoTo 0
End If
Next rng
'concatenate with "," as the delimiter for list in Sheet 2
For i = 2 To col.Count
dvlist1 = dvlist1 & col.Item(i) & ","
Next i
'add it to the DV
With Sheet1.Range("D3").Validation
.Delete
.Add Type:=xlValidateList, _
AlertStyle:=xlValidAlertStop, _
Formula1:=dvlist1
End With
End If
' This is for the date (YYYYMMDD) column. I need it to be in YYYYMMDD format:
If Not Intersect(Target, Range("F4:F13")) Is Nothing Then
If Not IsNumeric(.Value) And Not cel.NumberFormat = "yyyymmdd" Then
MsgBox "Date format must be in YYYYMMDD"
cel.Value = ""
Exit Sub
Else: cel.NumberFormat = "yyyymmdd"
End If
End With
End If
总的来说，你让自己的生活变得太艰难了。使用 Excel 提供的工具（而且有很多）；你不需要重新发明轮子。
例如，Sheet2 中的水果和原产国列表应该用作 Sheet1 中的数据验证列表（数据选项卡、数据工具、数据验证）。选择允许列表，确保选中忽略空白和单元格内下拉列表，并且 select 来自 Sheet2 的范围。
同样，您可以使用数据验证来验证最后一列中的日期。
您现在不需要自己验证这些列，因为它们总是有空白或有效值。
将此与我对条件格式的建议结合起来（例如，对于范围 c4:c13，您应该输入 =AND(B4<>"",ISBLANK(C4))，对于所有三列，您可以生成一个非常简单的验证例程。类似于：
Private Sub Workbook_BeforeClose(Cancel As Boolean)
Cancel = MissingEntries()
End Sub
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
Cancel = MissingEntries()
End Sub
Private Function MissingEntries() As Boolean
Dim i As Integer
Dim j As Integer
Dim atLeastOneLine As Boolean
atLeastOneLine = False
For i = 4 To 13
If (Cells(i, 2) <> "") Then
atLeastOneLine = True
For j = 3 To 6
If Cells(i, j) = "" Then
MsgBox ("Please supply values for highlighted cells")
MissingEntries = True
Exit Function
End If
Next
If WrongSerialNumber(i) Then
MissingEntries = True
Exit Function
End If
End If
Next
If Not atLeastOneLine Then
MsgBox ("Please supply values for at least one line")
MissingEntries = True
Else
MissingEntries = False
End If
End Function
Private Function WrongSerialNumber(i As Integer) As Boolean
Dim yr As Integer
Dim serialNo As String
Dim yrStr As String
Dim yrCell As String
serialNo = Cells(i, 2)
If Len(serialNo) < 3 Then
WrongSerialNumber = True
MsgBox "Serial Number for row no. " + CStr(i - 3) + " is too short. Please correct."
Exit Function
End If
yrCell = Cells(i, 6)
If Len(yrCell) = 8 Then
yr = CInt(Left(Cells(i, 6), 4))
If yr > 1968 Then
If Mid(yrCell, 3, 2) <> Mid(serialNo, 2, 2) Then
WrongSerialNumber = True
MsgBox "Serial Number for row no. " + CStr(i - 3) + " has wrong second and third digits. These should match the third and fourth digits of the date. Please correct."
Exit Function
End If
End If
End If
WrongSerialNumber = False
End Function
请注意，我在关闭和保存时都进行了验证。前者是可选的。
由于突出显示，一条简单的消息就足够了，您可以省去通知用户缺少哪些单元格的工作。通过这种方式，内置数据验证和条件格式的组合使您的任务的其余部分变得更加容易。
如果用户填写序列号。 col B中的列（不一定是全部10个，只要填一个即可），他们需要填写col C到col F的其他列。因此，如果 col B 已填满但 col C to F 中的任何单元格未填满，我希望弹出一条错误消息。我希望下面的图片能给你一个更清晰的想法..:[=21=]
我不确定 Worksheet_SelectionChange 是否会完成我想要完成的...因为我不想包含命令按钮。因为一些用户可能不愿意点击命令按钮来验证他们的输入。这是我目前的代码，请随时提出相应的建议....谢谢:)
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Range("B4").Value = "" Then
MsgBox "serial no. is a Mandatory field", vbExclamation, "Required Entry"
Range("B4").Select
End If
If Range("B4:B") <> "" Then
If Range("C4:C").Value = "" Then
MsgBox "Product is a Mandatory field", vbExclamation, "Required Entry"
Range("C4:C").Select
End If
' Adding values from sheet 2 for fruits drop-down list.
If Not Intersect(Target, Range("D3")) Is Nothing Then
Sheets("Sheet1").Range("D3") = "[Please Select]"
Dim col As New Collection
Dim rng As Range
Dim i As Long
Dim dvlist As String
'Loop thru the data range
For Each rng In Sheet2.Range("B2:B7")
'ignore blanks
If Len(Trim(rng.Value)) <> 0 Then
'create a unique list
On Error Resume Next
col.Add rng.Value, CStr(rng.Value)
On Error GoTo 0
End If
Next rng
'concatenate with "," as the delimiter
For i = 2 To col.Count
dvlist = dvlist & col.Item(i) & ","
Next i
With Sheet1.Range("C2:C").Validation
.Delete
.Add Type:=xlValidateList, _
AlertStyle:=xlValidAlertStop, _
Formula1:=dvlist
End With
End If
' Adding values from sheet 2 for country of origin drop-down list.
If Not Intersect(Target, Range("E4")) Is Nothing Then
Sheets("Screening Request").Range("E4") = "[Please Select]"
'Loop thru the data range
For Each rng In Sheet2.Range("A2:A7")
'ignore blanks
If Len(Trim(rng.Value)) <> 0 Then
'create a unique list
On Error Resume Next
col.Add rng.Value, CStr(rng.Value)
On Error GoTo 0
End If
Next rng
'concatenate with "," as the delimiter for list in Sheet 2
For i = 2 To col.Count
dvlist1 = dvlist1 & col.Item(i) & ","
Next i
'add it to the DV
With Sheet1.Range("D3").Validation
.Delete
.Add Type:=xlValidateList, _
AlertStyle:=xlValidAlertStop, _
Formula1:=dvlist1
End With
End If
' This is for the date (YYYYMMDD) column. I need it to be in YYYYMMDD format:
If Not Intersect(Target, Range("F4:F13")) Is Nothing Then
If Not IsNumeric(.Value) And Not cel.NumberFormat = "yyyymmdd" Then
MsgBox "Date format must be in YYYYMMDD"
cel.Value = ""
Exit Sub
Else: cel.NumberFormat = "yyyymmdd"
End If
End With
End If
总的来说，你让自己的生活变得太艰难了。使用 Excel 提供的工具（而且有很多）；你不需要重新发明轮子。
例如，Sheet2 中的水果和原产国列表应该用作 Sheet1 中的数据验证列表（数据选项卡、数据工具、数据验证）。选择允许列表，确保选中忽略空白和单元格内下拉列表，并且 select 来自 Sheet2 的范围。
同样，您可以使用数据验证来验证最后一列中的日期。
您现在不需要自己验证这些列，因为它们总是有空白或有效值。
将此与我对条件格式的建议结合起来（例如，对于范围 c4:c13，您应该输入 =AND(B4<>"",ISBLANK(C4))，对于所有三列，您可以生成一个非常简单的验证例程。类似于：
Private Sub Workbook_BeforeClose(Cancel As Boolean)
Cancel = MissingEntries()
End Sub
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
Cancel = MissingEntries()
End Sub
Private Function MissingEntries() As Boolean
Dim i As Integer
Dim j As Integer
Dim atLeastOneLine As Boolean
atLeastOneLine = False
For i = 4 To 13
If (Cells(i, 2) <> "") Then
atLeastOneLine = True
For j = 3 To 6
If Cells(i, j) = "" Then
MsgBox ("Please supply values for highlighted cells")
MissingEntries = True
Exit Function
End If
Next
If WrongSerialNumber(i) Then
MissingEntries = True
Exit Function
End If
End If
Next
If Not atLeastOneLine Then
MsgBox ("Please supply values for at least one line")
MissingEntries = True
Else
MissingEntries = False
End If
End Function
Private Function WrongSerialNumber(i As Integer) As Boolean
Dim yr As Integer
Dim serialNo As String
Dim yrStr As String
Dim yrCell As String
serialNo = Cells(i, 2)
If Len(serialNo) < 3 Then
WrongSerialNumber = True
MsgBox "Serial Number for row no. " + CStr(i - 3) + " is too short. Please correct."
Exit Function
End If
yrCell = Cells(i, 6)
If Len(yrCell) = 8 Then
yr = CInt(Left(Cells(i, 6), 4))
If yr > 1968 Then
If Mid(yrCell, 3, 2) <> Mid(serialNo, 2, 2) Then
WrongSerialNumber = True
MsgBox "Serial Number for row no. " + CStr(i - 3) + " has wrong second and third digits. These should match the third and fourth digits of the date. Please correct."
Exit Function
End If
End If
End If
WrongSerialNumber = False
End Function
请注意，我在关闭和保存时都进行了验证。前者是可选的。
由于突出显示，一条简单的消息就足够了，您可以省去通知用户缺少哪些单元格的工作。通过这种方式，内置数据验证和条件格式的组合使您的任务的其余部分变得更加容易。