Question

我是vba的新手，我有一个要求，即我必须将输入限制为工作表的A列，用户只能以以下格式输入字符串

'BATCH00_00'的数字范围为0-99，我尝试了以下代码，但无效

Private Sub Worksheet_Change(ByVal Target As Range)
'PURPOSE: Checks a specific column and validates that value follow a specified pattern (numbers or letter combinations)
Dim cell As Range, rng As Range
Dim InvalidCount As Long, x As Long
x = 3 'Column to Validate
Set rng = ActiveSheet.UsedRange.Columns(x).Offset(1).Resize(ActiveSheet.UsedRange.Rows.Count - 1, 1)
For Each cell In rng.Cells
  If Not UCase(cell.Value) Like "BATCH##_##Then
    'Highlight Invalid Cell Yellow
      msg "invalid entry please enter In following format BATCH00_00"

    Next cell
End Sub

我在工作表上还有另一个代码，该代码检查A列中不应有重复的条目

Private Sub Worksheet_Change(ByVal Target As Range)
Dim rng As Range, r As Range, msg As String, x As Range
Set rng = Intersect(Columns(1), Target)
If Not rng Is Nothing Then
Application.EnableEvents = False
For Each r In rng
If Not IsEmpty(r.Value) Then
If Application.CountIf(Columns(1), r.Value) > 1 Then
msg = msg & vbLf & r.Address(0, 0) & vbTab & r.Value
If x Is Nothing Then
                    r.activate
                    Set x = r
                Else
                    Set x = Union(x, r)
                End If
            End If
        End If
    Next
    If Len(msg) Then
        MsgBox "Duplicate values not allowed Invalid Entry" & msg
        x.ClearContents
        x.Select
   End If
    Set rng = Nothing
    Set x = Nothing
    Application.EnableEvents = True
End If
End Sub

如何使第一个代码正常工作并结合在一起以拥有一个Private Sub Worksheet_Change

Answer 1

尝试一下（用代码注释）

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim validationError Boolean
    validationError = False
    'if changed cell was not in A column, then exit sub
    If Target.Column <> 1 Then Exit Sub
    'check if format is valid BATCH00_00
    If Not Target.Value Like "BATCH[0-9][0-9]_[0-9][0-9]" Then
        MsgBox "Invalid format!"
        validationError = True
        Exit Sub
    End If
    'check for uniqueness in A column
    If Application.WorksheetFunction.CountIf(Range("A:A"), Target.Value) > 1 Then
        MsgBox "Values must be unique in A column!"
        validationError = True
    End If

    If validationError Then
        Application.EnableEvents = False
        Target.Value = ""
        Application.EnableEvents = True
    End If
End Sub

确保单元格值遵循指定的字符和数字组合

1 个答案: