VBA技术求助：拆分输入姓名并统计指定字符数问题

需求说明 #

• 从InputBox输入的姓名中拆分出FirstName（名）、MiddleName（中间名）、LastName（姓）
• 统计两项字符数：
  • 去空格后的完整姓名总字符数
  • 去空格后的FirstName与LastName总字符数
• 示例：
  • 输入Matt Lose Wright，完整姓名去空格后字符数为15（MattLoseWright共15位）
  • 输入Matt Wright，FirstName+LastName去空格后字符数为10（MattWright共10位）

你提供的测试代码 #

Sub ParseName()
    Dim name As String
    name = InputBox("Enter First Name, Middle Name, and Last Name")
    
    Dim First As Double
    Dim Middle As Double
    Dim Last As Double
    
    First = InStr(1, name, "First", vbTextCompare)
    Middle = InStr(2, name, "Middle", vbTextCompare)
    Last = InStr(3, name, "Last", vbTextCompare)
    
    Dim Count As Integer
    Dim Cell As Object
    Dim n As Integer
    Count = 0
    name = InputBox("Enter First Name, Middle Name, and Last Name")
    If name = "" Then
        For Each Cell In Selection
         n = InStr(1, Cell.Value, name)
         While n <> 0
            Count = Count + 1
            n = InStr(n + 1, Cell.Value, name)
         Wend
      Next Cell
    MsgBox Count & " Occurrences of " & name
    End If
End Sub

原代码问题分析 #

1. 错误用InStr查找"First""Middle""Last"，这不是输入姓名里的内容，完全找错了方向
2. 重复弹出InputBox，逻辑混乱
3. 代码核心逻辑是统计空字符串的出现次数，和需求完全不匹配

修正后的代码 #

Sub ParseNameAndCount()
    Dim inputName As String
    inputName = Trim(InputBox("请输入姓名（支持名+中间名+姓，或名+姓）"))
    
    ' 空输入直接退出
    If inputName = "" Then
        MsgBox "请输入有效姓名"
        Exit Sub
    End If
    
    ' 按空格拆分姓名为数组（自动忽略连续空格）
    Dim nameParts() As String
    nameParts = Split(WorksheetFunction.Trim(inputName), " ")
    
    Dim firstName As String, middleName As String, lastName As String
    Select Case UBound(nameParts) + 1 ' 数组元素个数
        Case 2 ' 名+姓
            firstName = nameParts(0)
            lastName = nameParts(1)
        Case 3 ' 名+中间名+姓
            firstName = nameParts(0)
            middleName = nameParts(1)
            lastName = nameParts(2)
        Case Else ' 处理其他情况（比如单名或超过3部分）
            MsgBox "请输入符合格式的姓名（名+姓，或名+中间名+姓）"
            Exit Sub
    End Select
    
    ' 计算两项字符数
    Dim fullNameNoSpaceLen As Integer
    fullNameNoSpaceLen = Len(Replace(inputName, " ", ""))
    
    Dim firstLastNoSpaceLen As Integer
    firstLastNoSpaceLen = Len(firstName) + Len(lastName)
    
    ' 弹窗显示结果
    MsgBox "完整姓名去空格后字符数：" & fullNameNoSpaceLen & vbCrLf & _
           "名+姓去空格后字符数：" & firstLastNoSpaceLen
End Sub

代码说明 #

• 用Trim和WorksheetFunction.Trim处理输入的首尾空格和连续空格，避免拆分出错
• 通过Split按空格拆分姓名，根据拆分后的元素个数判断是否有中间名
• 用Replace去掉空格计算完整姓名长度，直接取名和姓的长度相加得到第二项统计值
• 增加了空输入和格式错误的提示，提升易用性

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