[英]Use VBA Script To Parse Full Name Into Parts
我為這一切尋找了一個解決方案,但找不到一個有效的或我可以修改的解決方案。 我有一個全名列表,可能包含也可能不包含中間名、中間名首字母和后綴。 使用 VBA 腳本,我需要將名稱解析為適當的單獨列,如下所示。 (注 - 后綴可能包括 Jr、Jr.、Sr、Sr.、II、III、IV 和 V...現在)
我最接近的是這個代碼:(其中“emptyRow”已經被確定為第一個沒有數據的可用行)
Dim MyText As String
Dim i As Integer
Dim MyResult() As String
MyText = Range("A" & emptyRow).Value
MyResult = Split(MyText)
For i = 0 To UBound(MyResult)
Cells(emptyRow, i).Value = MyResult(i)
Next I
但是,它對丟失的項目(如中間名或后綴)沒有任何作用。
關於如何使其發揮作用的任何想法或不同的方法?
(A1)全名 | (B1)名字 | (C1)中間名 | (D1)姓氏 | (E1)后綴 |
---|---|---|---|---|
小約翰·亞當·多伊 | 約翰 | 亞當 | 美國能源部 | 小 |
小約翰·多伊 | 約翰 | 一種 | 美國能源部 | 小 |
小約翰·多伊 | 約翰 | 美國能源部 | 小 | |
約翰·亞當·多 | 約翰 | 亞當 | 美國能源部 | |
約翰·多伊 | 約翰 | 一種 | 美國能源部 | |
約翰·多伊 | 約翰 | 美國能源部 |
更新:
所以,這就是我想出的。 我相信它可以更漂亮,但我認為它有效。
MyResult = Split(MyText)
i = UBound(MyResult)
Cells(emptyRow, 1).Value = MyResult(0)
If MyResult(i) = "Jr." Or MyResult(i) = "Jr" Or MyResult(i) = "Sr." Or MyResult(i) = "Sr" Or MyResult(i) = "II" Or MyResult(i) = "ii" Or MyResult(i) = "III" Or MyResult(i) = "IIi" Or MyResult(i) = "Iii" Or MyResult(i) = "IiI" Or MyResult(i) = "iii" Or MyResult(i) = "iIi" Or MyResult(i) = "iiI" Or MyResult(i) = "iII" Or MyResult(i) = "iI" Or MyResult(i) = "Ii" Or MyResult(i) = "IV" Or MyResult(i) = "V" Or MyResult(i) = "iv" Or MyResult(i) = "v" Or MyResult(i) = "Iv" Or MyResult(i) = "iV" Then
If i = 5 Then
Cells(emptyRow, 4).Value = MyResult(i)
Cells(emptyRow, 3).Value = MyResult(3) & " " & MyResult(4)
Cells(emptyRow, 2).Value = MyResult(1) & " " & MyResult(2)
ElseIf i = 4 Then
Cells(emptyRow, 4).Value = MyResult(i)
Cells(emptyRow, 3).Value = MyResult(2) & " " & MyResult(3)
Cells(emptyRow, 2).Value = MyResult(1)
ElseIf i = 3 Then
Cells(emptyRow, 4).Value = MyResult(i)
Cells(emptyRow, 3).Value = MyResult(2)
Cells(emptyRow, 2).Value = MyResult(1)
Else
Cells(emptyRow, 4).Value = MyResult(i)
Cells(emptyRow, 3).Value = MyResult(1)
End If
ElseIf i = 4 Then
Cells(emptyRow, 3).Value = MyResult(3) & " " & MyResult(4)
Cells(emptyRow, 2).Value = MyResult(1) & " " & MyResult(2)
ElseIf i = 3 Then
Cells(emptyRow, 3).Value = MyResult(2) & " " & MyResult(3)
Cells(emptyRow, 2).Value = MyResult(1)
ElseIf i = 2 Then
Cells(emptyRow, 3).Value = MyResult(2)
Cells(emptyRow, 2).Value = MyResult(1)
Else
Cells(emptyRow, 3).Value = MyResult(1)
End If
想法??
這是我的看法。 我選擇了在中間名或姓氏中使用額外的名字。 它制作得很快,而且是一種相當基本的方法,我相信有多種方法可以改進它,但無論如何它都能很好地工作。
試一試吧。 只需設置和更改必要的部分。
Sub ExtractName()
Dim ws As Worksheet, lRow As Long, i As Long, SplitName, IsSuffix As Boolean
Dim LastNamePos As Integer, j As Integer, SplitLast As Integer, LastStart As Integer
Set ws = Sheets("Sheet1")
lRow = ws.Range("A" & ws.Rows.Count).End(xlUp).Row 'Change column as needed
With ws
For i = 2 To lRow 'change starting row if needed
SplitName = Split(.Range("A" & i), " ")
SplitLast = UBound(SplitName)
Select Case SplitName(SplitLast)
Case "Jr", "Jr.", "Sr", "Sr.", "II", "III", "IV", "V"
.Range("E" & i) = SplitName(SplitLast) 'Add Suffix to column
IsSuffix = True
Case Else
IsSuffix = False
End Select
.Range("B" & i) = SplitName(0) 'Add first name to column
If IsSuffix = True Then
LastNamePos = 1
Else
LastNamePos = 0
End If
'---------------------- Extra names go to middle name
.Range("D" & i) = SplitName(SplitLast - LastNamePos) 'Add last name to column
For j = 1 To SplitLast - LastNamePos - 1 'Add middle names to column
If .Range("C" & i) = "" Then
.Range("C" & i) = SplitName(j)
Else
.Range("C" & i) = .Range("C" & i) & " " & SplitName(j)
End If
Next j
'---------------------- Extra names go to last name
' If IsSuffix = True And SplitLast >= 3 Then
' .Range("C" & i) = SplitName(1)
' LastStart = 2
' ElseIf IsSuffix = False And SplitLast >= 2 Then
' .Range("C" & i) = SplitName(1)
' LastStart = 2
' Else
' LastStart = 1
' End If
' For j = LastStart To SplitLast - LastNamePos
' If .Range("D" & i) = "" Then
' .Range("D" & i) = SplitName(j)
' Else
' .Range("D" & i) = .Range("D" & i) & " " & SplitName(j)
' End If
' Next j
Next i
End With
End Sub
聲明:本站的技術帖子網頁,遵循CC BY-SA 4.0協議,如果您需要轉載,請注明本站網址或者原文地址。任何問題請咨詢:yoyou2525@163.com.