将前缀 vba 函数限制在动态范围内

Question

enter link description here我想将低于 vba 的代码限制在动态范围内的 A 列中。现在，如果我输入超出范围的内容，它会显示错误并破坏 Workbook_SheetChange 中的其他功能。我附上我的文件以便于参考。请帮忙！帮助

    'Formate Column A
If Target.Column = 1 Then
    Dim s As String
    Dim arr As Variant

    s = Target.Value
    If s = "" Then
      Target.NumberFormat = "General"
    Else
      With CreateObject("vbscript.regexp")
        .Pattern = "[^0-9]"
        .Global = True
        .IgnoreCase = True
        arr = Split(Application.Trim(.Replace(s, " ")), " ")
      End With
      Target.Value = arr
      Target.Value = Target.Value * 1
      Target.NumberFormat = """REQ0000000""General"
    End If

Answer 1

    'Excel file link : https://drive.google.com/file/d/13w-AbgY83g02qHGqBrHr_6N26UkNpWKr/view?usp=sharing


Private Sub Workbook_BeforeClose(Cancel As Boolean)
        Call Module1.DeleteCheck
End Sub

Private Sub Workbook_Open()
        Call Module1.CreateCheck
        'Application.MoveAfterReturnDirection = xlToRight
        'Application.MoveAfterReturn = True
            

End Sub


Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
 
    
  Select Case Sh.Name
    Case "Agents"
      Exit Sub
    Case Else
  End Select
 
      
  If Target.Column > 4 Or Target.CountLarge > 1 Then Exit Sub
  If Target.Row = 1 Then Exit Sub

 
  Application.EnableEvents = False
 
  If InStr(1, Cells(Target.Row, "A"), "REQ") <> "" And Cells(Target.Row, "B") <> "" Then
 
        Cells(Target.Row, "C") = ActiveSheet.Name
        Cells(Target.Row, "C").Font.Name = "Times New Roman"
        Cells(Target.Row, "C").Font.Size = 12
        Cells(Target.Row, "C").HorizontalAlignment = xlRight
        Cells(Target.Row, "D").ShrinkToFit = True
        Cells(Target.Row, "A").Font.Name = "Times New Roman"
        Cells(Target.Row, "A").Font.Size = 12
        Cells(Target.Row, "A").HorizontalAlignment = xlLeft
        Cells(Target.Row, "B").Font.Name = "Times New Roman"
        Cells(Target.Row, "B").Font.Size = 12
        Cells(Target.Row, "B").HorizontalAlignment = xlLeft
      
   End If
 
 
'Formate Column A
If Target.Column = 1 Then
    Dim s As String
    Dim arr As Variant

    s = Target.Value
    If s = "" Then
      Target.NumberFormat = "General"
    Else
      With CreateObject("vbscript.regexp")
        .Pattern = "[^0-9]"
        .Global = True
        .IgnoreCase = True
        arr = Split(Application.Trim(.Replace(s, " ")), " ")
      End With
      Target.Value = arr
      Target.Value = Target.Value * 1
      Target.NumberFormat = """REQ0000000""General"
    End If
  End If
 
 
  'Set Cell Movement within The Range
  'https://www.mrexcel.com/board/threads/set-movement-of-cells-in-dynamic-range-only.1172539/
   If Target.CountLarge > 1 Then Exit Sub
 
  
    Dim rng As Range
    Set rng = Range("A1").CurrentRegion
    If rng.Rows.Count > 1 Then
        Set rng = Intersect(Target, rng.Offset(1, 0).Resize(rng.Rows.Count - 1, rng.Columns.Count))
    Else
        Set rng = Nothing
    End If
    If Not rng Is Nothing Then
        If Target.Column = 2 And Not (IsEmpty(Target)) Then
            Target.Offset(, 2).Select
        Else
            Target.Offset(, 1).Select`enter code here`
        End If
    End If
 
  Application.EnableEvents = True

End Sub


Private Sub Workbook_SheetBeforeRightClick(ByVal Sh As Object, ByVal Target As Range, Cancel As Boolean)

  Select Case Sh.Name
    Case "Agents"
      Exit Sub
    Case Else
  End Select

  If Target.Column <> 5 Or Application.CountA(Cells(Target.Row, 1).Resize(, 2)) < 2 Then Exit Sub
  Cancel = True
  Call Module3.SelectOLE3

End Sub


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

  Select Case Sh.Name
    Case "Agents"
      Exit Sub
    Case Else
  End Select

  If g_blnWbkShtSelChange Then Exit Sub
  If Selection.Count = 1 Then
    If Not Intersect(Target, Range("C1")) Is Nothing Then
      g_blnWbkShtSelChange = True
      Call Module1.CheckSheet
    End If
  End If

End Sub

将前缀 vba 函数限制在动态范围内

Limit the prefix vba function to dynamic range

vba

prefix