VBA代码修复请求：阿拉伯名字拆分并标记字符首/中/尾

需要将阿拉伯名字“حاتم علاء خميس سيد”拆分为单个字符，并按以下规则标记：

• 每个姓名片段的首字符标记为First
• 片段中间的字符标记为Middle
• 片段末尾（后接空格）或整个姓名的最后一个字符标记为Last

修复后的VBA代码 #

Sub Split_Arabic_Name()
    Dim sName As String
    sName = "حاتم علاء خميس سيد"
    
    ' 按空格拆分姓名片段
    Dim nameParts() As String
    nameParts = Split(sName, " ")
    
    Dim allChars As Collection
    Set allChars = New Collection
    
    ' 遍历每个姓名片段，拆分字符并标记
    Dim part As Variant
    For Each part In nameParts
        Dim partLen As Long, i As Long
        partLen = Len(part)
        i = 1
        Do While i <= partLen
            Dim char As String
            ' 处理阿拉伯文双字节代理对字符
            If AscW(Mid(part, i, 1)) >= &HD800 And AscW(Mid(part, i, 1)) <= &HDBFF Then
                char = Mid(part, i, 2)
                i = i + 2
            Else
                char = Mid(part, i, 1)
                i = i + 1
            End If
            
            ' 标记字符类型
            Dim tag As String
            If i - IIf(Len(char) = 2, 2, 1) = 1 Then
                ' 片段的第一个字符
                tag = "First"
            ElseIf i > partLen Then
                ' 片段的最后一个字符
                tag = "Last"
            Else
                ' 片段的中间字符
                tag = "Middle"
            End If
            
            allChars.Add Array(char, tag)
        Loop
    Next part
    
    ' 将结果写入工作表
    Dim resultArr() As String
    ReDim resultArr(1 To allChars.Count, 1 To 2)
    Dim idx As Integer
    For idx = 1 To allChars.Count
        resultArr(idx, 1) = allChars(idx)(0)
        resultArr(idx, 2) = allChars(idx)(1)
    Next idx
    
    Range("H1").Resize(UBound(resultArr, 1), UBound(resultArr, 2)).Value = resultArr
End Sub

修复要点说明 #

• 拆分逻辑优化：先按空格将姓名拆分为独立片段，再逐个处理片段内的字符，彻底解决原代码中字符索引与原字符串位置不匹配的问题
• 字符处理修正：正确识别阿拉伯文的双字节Unicode代理对，确保每个字符被完整提取，避免拆分出残缺字符
• 标记逻辑修复：针对每个片段内的字符位置精准判断标记类型，完全符合需求规则
• 性能优化：使用Collection临时存储字符和标记，避免频繁ReDim Preserve数组带来的性能损耗，最后统一转换为二维数组写入工作表

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