求Excel大神解决一个vba的问题

kristzhang

怎么限制vba中textbox的输入规则？

要求：原文件为半成品，需要在半成品文件中修改代码：半成品Excel
如图，我需要限制在输入框中只能输入数值、空格并且可以换行（回车键换行）
格式要求：每行输入的数字格式为数字+空格：
1 2 3 4 5 6 7 或者
11 12 13 14 15 16 17 或者
1 7 12 13 22 21 3（这种一位数和两位数混排的）
每行7个数，为1-33的整数 ，空格隔开
最多不超过30行
超出限制自动删除不符合要求的部分


补充说明：我需要的是只能录入数字、空格并能换行，录入错误信息自动删除，并且最多只能录入30行，每行算上空格13-20字符，如字符不够就在换行的时候提示，如果超出就限制21个字符的输入

fhangong

可以了，请再试试，一排如果不够7个数字，强止不换行。
链接：https://pan.baidu.com/s/1Emn1xCtlSwxDU8tARUoynA
提取码：52pj
--来自百度网盘超级会员V5的分享

小哲网络

[Visual Basic] 纯文本查看 复制代码

要在VBA中实现文本框的输入限制，并满足您提出的各项要求，您可以使用`UserForm`中的`TextBox`控件的`KeyPress`和`Change`事件。以下是一段示例代码，它将实现您的要求：

首先，打开Excel，然后按下 `Alt + F11` 打开VBE（Visual Basic for Applications 编辑器）。在 `插入` 菜单中选择 `UserForm`。

然后，向UserForm添加一个TextBox控件，并将其Name属性设置为`TextBoxNumbers`。接下来，复制以下代码到UserForm的代码模块中：

```vba
Private Sub TextBoxNumbers_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
    ' 只允许数字、空格、回车键
    If Not (KeyAscii >= 48 And KeyAscii <= 57) And KeyAscii <> 32 And KeyAscii <> 8 And KeyAscii <> 13 Then
        KeyAscii = 0
    End If
End Sub

Private Sub TextBoxNumbers_Change()
    Dim lines() As String
    Dim currentLine As String
    Dim i As Integer
    Dim nums() As String
    Dim currentNum As Integer
    
    ' 按行分离输入
    lines = Split(Me.TextBoxNumbers.Text, vbNewLine)
    
    ' 限制输入行数
    If UBound(lines) > 29 Then ' 数组基于0，所以30行会是索引29
        Me.TextBoxNumbers.Text = Join(ArraySlice(lines, 0, 29), vbNewLine)
        With Me.TextBoxNumbers
            .SetFocus
            .SelStart = Len(.Text)
        End With
    End If
    
    ' 检查每一行的数字格式
    For i = 0 To UBound(lines)
        currentLine = lines(i)
        ' 移除行尾的空格
        currentLine = RTrim(currentLine)
        nums = Split(currentLine, " ")
        If UBound(nums) > 6 Or (currentLine <> "" And Not currentLine Like String(UBound(nums), "#")) Then
            lines(i) = ""
        Else
            ' 检查每个数字是否在1-33之间
            For Each num In nums
                currentNum = Val(num)
                If currentNum < 1 Or currentNum > 33 Then
                    lines(i) = ""
                    Exit For
                End If
            Next num
        End If
    Next i

    ' 重构输入框内容
    Me.TextBoxNumbers.Text = Join(lines, vbNewLine)
    With Me.TextBoxNumbers
        .SetFocus
        .SelStart = Len(.Text)
    End With
End Sub

' 辅助函数：返回数组的一个片段
Function ArraySlice(arr As Variant, startIndex As Long, endIndex As Long) As String()
    Dim result() As String
    Dim i As Long
    ReDim result(endIndex - startIndex)
    
    For i = startIndex To endIndex
        result(i - startIndex) = arr(i)
    Next i
    
    ArraySlice = result
End Function
```

在上述代码中，`KeyPress`事件确保只有数字、空格、回退键和回车键可以被输入。`Change`事件用来检查和格式化文本框内的文本，确保每一行只包含7个1至33之间的数字，并且行数不超过30。

由于文本框内容的变更可能会触发`Change`事件，在重新设置文本框内容时需要防止无限循环。设置文本框的内容会再次触发`Change`事件，因此代码中有一处聚焦和光标位置的设置，用以保持用户的输入位置。

请注意，以上代码示例基于特定的输入规则和格式要求。在实际应用中，您可能需要根据具体情况做一些调整。

lisongmei

Private Sub CommandButton1_Click()

    If TextBox1.Value = "" Then
    MsgBox "预测数据不能为空，请输入正确的预测数据！"
    Exit Sub
    End If
    Dim numbers As Variant
    Dim i As Long
    Dim targetSheet As Worksheet
    Dim targetRange As Range


在这里加一串这个代码，不符合规则时，直接停止程序，你试一下，下面华丽分割线之间
--------------------------------------------------------------
    Dim reg
    Set reg = CreateObject("vbscript.regexp")
    With reg
        sr = TextBox1.Text
        .Pattern = "^(([1-2][0-9]?|3[0-3]?)(\s|$)){7}"
        .Global = True
        If Not .test(sr) Then End
    End With
-------------------------------------------------------------------
    numbers = Split(TextBox1.Text, " ")

kristzhang

小哲网络 发表于 2024-4-1 18:22
[mw_shl_code=vb,true]要在VBA中实现文本框的输入限制，并满足您提出的各项要求，您可以使用`UserForm`中的 ...

能不能在原Excel文件中帮忙修改一下代码？谢谢

lisongmei

[Visual Basic] 纯文本查看 复制代码

Private Sub CommandButton1_Click()

    If TextBox1.value = "" Then
    MsgBox "预测数据不能为空，请输入正确的预测数据！"
    Exit Sub
    
End If
    Dim numbers As Variant
    Dim i As Long
    Dim targetSheet As Worksheet
    Dim targetRange As Range
'华丽分割线之间，这个完整的。你可以一用。下午的配合你的多少有点问题，现在目测没问题
'华丽分割线---------------------------------------------
    Dim reg, m, ms
    Dim row%
    Set reg = CreateObject("vbscript.regexp")
    With reg
        sr = TextBox1.Text
        .Pattern = "^(?:(?:[1-2][0-9]?|3[0-3]?) ){6}(?:[1-2][0-9]?|3[0-3]?)$"
        .Global = True
        .MultiLine = True
        If .test(sr) Then
            Set ms = .Execute(sr)
            For Each m In ms
                row = row + 1
                If row <= 30 Then
                     arr = VBA.Split(m.value, " ")
                     Sheets("Sheet1").Range("a" & row).Resize(1, 7) = arr
                Else
                    Exit For
                End If
            Next
            MsgBox "数据录入完成！"
            TextBox1.value = ""
        Else
            End
        End If
    End With
 
 '华丽分割线---------------------------------------------
'    numbers = Split(TextBox1.Text, " ")
'
'    Set targetSheet = ThisWorkbook.Sheets("Sheet1")
'
'    Set targetRange = targetSheet.Range("A1")
'
'    For i = LBound(numbers) To UBound(numbers) Step 7
'
'        targetRange.Resize(1, 7).value = Array(numbers(i), numbers(i + 1), numbers(i + 2), numbers(i + 3), numbers(i + 4), numbers(i + 5), numbers(i + 6))
'        Set targetRange = targetRange.Offset(1, 0)
'    Next i
'
'    MsgBox "数据录入完成！"
'    TextBox1.value = ""
    
End Sub

kristzhang

lisongmei 发表于 2024-4-1 19:32
[mw_shl_code=vb,true]Private Sub CommandButton1_Click()

    If TextBox1.value = "" Then

没用，一样可以录入文字特殊符号。我需要的是只能录入数字、空格并能换行，录入错误信息自动删除，并且最多只能录入30行，每行算上空格13-20字符，如字符不够就在换行的时候提示，如果超出几限制21个字符的输入

lisongmei

kristzhang 发表于 2024-4-1 19:40
没用，一样可以录入文字特殊符号。我需要的是只能录入数字、空格并能换行，录入错误信息自动删除，并且最 ...

是只能录入数字，空格+换行嘛，录入其他就直接停止程序，无结果，但是如果你里面多选录入的有一个正确的，也能把这个正确的给你输出。这个可以录入无数行，但是只取前30个正确结果。。。这个可能我理解不对。
可能我理解错了。。。至于自动删除很简单。因为你之前的代码没写这些，也没有去处理单元格里的内容，所以我也就没写。只是去判断内容。

莫非你不会是想让文本框了限制字符数吧。。。？

kristzhang

lisongmei 发表于 2024-4-1 19:46
是只能录入数字，空格+换行嘛，录入其他就直接停止程序，无结果，但是如果你里面多选录入的有一个正确的 ...

简单的就是：文本框只能输入数字、空格和可以换行，如果输入了其他内容就自动删除（不能录入，在文本框就自动消除错误的值，比如输入文字，就直接不出现在文本框），最多30行数据。每行的录入字符区间13-20个字符含空格，不含空格就是7-14个，如果该行字符不够，就在换行的时候提示，如果最后一行不够就在提交的时候提示，如果超出限制就直接不能输入超出的部分（如果不好实现也可以在换行的时候提示修改即可），不知道我表述清楚没有

kristzhang

lisongmei 发表于 2024-4-1 19:46
是只能录入数字，空格+换行嘛，录入其他就直接停止程序，无结果，但是如果你里面多选录入的有一个正确的 ...

因为对这个不是很懂，原文件也是跟着教程写的，只写了文本框输入没有做其他任何限定。