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

Posted

技术标签:

【中文标题】将前缀 vba 函数限制为动态范围【英文标题】:Limit the prefix vba function to dynamic range 【发布时间】:2021-07-02 20:07:52 【问题描述】:

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

【问题讨论】:

如果(至少)你错过了一个结局。包括完整的代码,它会更容易帮助你 这是完整的代码。您可以使用提供的链接下载我的文件。如果活动单元格不是表格的连续行,我需要帮助修改代码以允许我像往常一样输入任何数字或字母值。 【参考方案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

【讨论】:

@Tim,非常感谢

以上是关于将前缀 vba 函数限制为动态范围的主要内容,如果未能解决你的问题,请参考以下文章

以编程方式(VBA,C#)将数组字符串设置为范围时,奇怪的单元格中字符数限制

VBA范围255个字符限制[重复]

VBA范围255字符限制[重复]

选定范围内的VBA验证

Excel VBA 将范围复制到 1,048,576 行后的新工作表

Excel VBA:如何将代码执行限制在工作表中