EXCEL/VBA：TextBox实时格式化代码异常问题求助

我明白你遇到的麻烦了——原代码的Format函数用在这里并不适配，再加上光标定位逻辑有缺陷，才会导致格式乱掉或者触发无限循环。咱们来一步步修复这个问题：

首先拆解原代码的核心问题：

• Format("###-###.###-###")会在输入未完成时自动补空格，还会错误处理非数字字符，直接打乱格式
• 光标定位只硬编码了小数点前的位置，完全没考虑用户在输入过程中（比如修改中间数字）的光标位置
• 没有过滤非数字输入，用户不小心输入的字母、符号都会干扰格式化效果

下面是完全适配你需求的修正代码：

Dim CursorPosition As Long
Dim boolSkip As Boolean

Private Sub TextBox1_Change()
    ' 避免事件重复触发，防止无限循环
    If boolSkip = True Then
        boolSkip = False
        Exit Sub
    End If
    
    Dim rawText As String
    Dim formattedText As String
    Dim i As Integer
    
    ' 第一步：过滤所有非数字字符，只保留用户输入的数字
    rawText = ""
    For i = 1 To Len(TextBox1.Text)
        If IsNumeric(Mid(TextBox1.Text, i, 1)) Then
            rawText = rawText & Mid(TextBox1.Text, i, 1)
        End If
    Next i
    
    ' 记录当前光标位置（转换为过滤后纯数字的位置）
    CursorPosition = GetCursorInRawText(TextBox1.SelStart, TextBox1.Text)
    
    boolSkip = True ' 标记跳过下一次Change事件触发
    
    ' 第二步：根据数字长度分阶段实时格式化
    formattedText = ""
    Select Case Len(rawText)
        Case 1 To 3
            formattedText = rawText
        Case 4 To 6
            formattedText = Left(rawText, 3) & "-" & Mid(rawText, 4)
        Case 7 To 9
            formattedText = Left(rawText, 3) & "-" & Mid(rawText, 4, 3) & "." & Mid(rawText, 7)
        Case 10 To 12
            formattedText = Left(rawText, 3) & "-" & Mid(rawText, 4, 3) & "." & Mid(rawText, 7, 3) & "-" & Mid(rawText, 10)
        Case Else
            ' 超过12位只保留前12位数字并格式化
            formattedText = Left(rawText, 3) & "-" & Mid(rawText, 4, 3) & "." & Mid(rawText, 7, 3) & "-" & Mid(rawText, 10, 3)
            rawText = Left(rawText, 12)
    End Select
    
    ' 更新TextBox内容
    TextBox1.Text = formattedText
    
    ' 第三步：把纯数字的光标位置转换回格式化后的位置
    CursorPosition = GetCursorInFormattedText(CursorPosition, formattedText)
    ' 确保光标不会超出文本长度
    If CursorPosition > Len(formattedText) Then CursorPosition = Len(formattedText)
    TextBox1.SelStart = CursorPosition
    
    boolSkip = False
End Sub

' 辅助函数：将格式化文本的光标位置转换为纯数字的位置
Private Function GetCursorInRawText(formattedPos As Integer, formattedText As String) As Integer
    Dim rawPos As Integer
    rawPos = 0
    For i = 1 To formattedPos
        If IsNumeric(Mid(formattedText, i, 1)) Then
            rawPos = rawPos + 1
        End If
    Next i
    GetCursorInRawText = rawPos
End Function

' 辅助函数：将纯数字的光标位置转换为格式化文本的位置
Private Function GetCursorInFormattedText(rawPos As Integer, formattedText As String) As Integer
    Dim formattedPos As Integer
    formattedPos = 0
    Dim digitCount As Integer
    digitCount = 0
    
    For i = 1 To Len(formattedText)
        formattedPos = formattedPos + 1
        If IsNumeric(Mid(formattedText, i, 1)) Then
            digitCount = digitCount + 1
            If digitCount = rawPos Then
                Exit For
            End If
        End If
    Next i
    
    ' 如果原始位置超过数字长度，光标自动移到文本末尾
    If digitCount < rawPos Then formattedPos = Len(formattedText) + 1
    GetCursorInFormattedText = formattedPos
End Function

代码核心优势： #

1. 纯数字过滤：自动剔除所有非数字字符，避免无关输入干扰格式
2. 渐进式格式化：输入过程中会根据数字长度自动添加分隔符（第4位加-、第7位加.），输入体验流畅
3. 智能光标定位：两个辅助函数保证输入/修改时光标不会乱跑，始终停留在用户操作的数字位置
4. 彻底避免循环：boolSkip标记精准控制事件触发，不会出现无限循环问题

测试一下：输入123456789852会自动变成123-456.789-852，输入过程中每到对应位数就自动补充分隔符，修改中间数字时光标也能准确回到目标位置。

内容的提问来源于stack exchange，提问作者Pedro Gaspar