使用 VBA 提取名字中间名和姓氏答案

【问题标题】：Extract First Name Middle Name and Last Name Using VBA使用 VBA 提取名字中间名和姓氏
【发布时间】：2020-07-09 15:08:42
【问题描述】：

我已经接近找到解决方案，但并不完全。我想在单独的名称字段中分隔名字、中间名（如果存在）和姓氏。数据和当前结果：

Data             FName           LName
Doe,John         John            Doe
Doe,John A       John A          Doe
Doe,John Art, Jr John Art, Jr    Doe

代码：

First_Name: Mid([Client Name],InStr([Client Name],",")+1)
Last_Name: Left([Client Name],InStr([Client Name],",")-1)

如您所见，我现在并不专注于中间名，但也想在中间名/首字母的 MName 中捕捉到这一点。我在网上发现很多选项都接近这一点，但没有一个可以完成让数据看起来像这样的任务：

Data             FName         MName      LName
Doe,John         John                     Doe
Doe,John A       John          A          Doe
Doe,John Art, Jr John          Art        Doe Jr
Doe,John A, Jr   John          A          Doe JR

谢谢

【问题讨论】：

标签： vba ms-access

【解决方案1】：

编辑：添加mName初始化

试试这个

选项显式

Sub names()

Dim namesRng As Range, cell As Range
Dim arr As Variant
Dim fName As String, mName As String, lName As String

Set namesRng = ActiveSheet.Range("A2:A10") '<== here set the actual range of "Data", header excluded

For Each cell In namesRng.SpecialCells(xlCellTypeConstants, xlTextValues)

    arr = Split(cell.value, ",")
    lName = Trim(arr(0))
    If UBound(arr) = 2 Then lName = lName & " " & Trim(arr(2))
    arr = Split(Trim(arr(1)))
    fName = Trim(arr(0))
    mName=""
    If UBound(arr) = 1 Then mName = Trim(arr(1))

    cell.Offset(, 1).Resize(, 3) = Array(fName, mName, lName)

Next cell

End Sub

【讨论】：

【解决方案2】：

用空格替换逗号，用单个空格替换生成的双空格。

然后开始根据空格拆分字符串。

假设：

总是至少有名字和姓氏，如果只有名字的可能性，像我的代码中那样的 IF 将解决这个问题。

姓氏只有一个后缀（即 jr）

Sub FixNames()
Dim MyString As String, FirstName As String, MiddlePart As String, Surname As String, X As Long
For X = 2 To Range("A" & Rows.Count).End(xlUp).Row
    FirstName = "": MiddlePart = "": Surname = ""
    MyString = Replace(Replace(Range("A" & X).text, ",", " "), "  ", " ")
    FirstName = Split(Replace(MyString, ",", " "), " ")(1)
    Surname = Split(Replace(MyString, ",", " "), " ")(0)
    If Len(MyString) - Len(Replace(MyString, " ", "")) >= 2 Then MiddlePart = Split(Replace(MyString, ",", " "), " ")(2)
    If Len(MyString) - Len(Replace(MyString, " ", "")) > 2 Then Surname = Surname & " " & Split(Replace(MyString, ",", " "), " ")(3)
    Range("B" & X).Formula = FirstName
    Range("C" & X).Formula = MiddlePart
    Range("D" & X).Formula = Surname
Next
End Sub

【讨论】：

【解决方案3】：

选项显式

子名称()

Dim name As String

Dim first_name As String
Dim mid_name As String
Dim last_name As String

name = "AA,BB,CC"

first_name = Left(name, InStr(name, ",") - 1)

mid_name = Mid(name, InStr(name, ",") + 1, InStrRev(name, ",") - InStr(name, ",") - 1)

last_name = Right(name, Len(name) - InStrRev(name, ","))

MsgBox first_name & Chr(10) & mid_name & Chr(10) & last_name

结束子

【讨论】：