VBA 当字符串具有变量定界符时将其拆分为多个单元格
VBA Splitting a String into multiple cells when it has variable Delimiters
如果我将以下信息全部包含在一个单元格中,并且我想将其拆分为单独的单元格。我知道如何使用 space 作为分隔符,但在这种情况下,名称也有 spaces,我希望名称一起留在一个单元格中。更复杂的是,名字并不总是只有名字和姓氏,它还可以包括中间名,因此并不总是标准的两个名字。
2172571122 Jane Doe 3143332222 John Doe
2172242237 Mary Mixer 2223334444 Mike M Martin
希望它最终看起来像这样:
Cell 1 = 2172242237
Cell 2 = Mary Mixer
Cell 3 = 2223334444
Cell 4 = Mike M Martin
有什么建议吗?
关于您可以做什么,我有一些想法。
1) 读一行
执行 split(line, " ")
并循环索引,同时对每个拆分值执行 isNumeric()
。如果不是,则添加到字符串 Array() 并将标志设置为 true。
然后,如果 isnumeric 那么,期望另一个名称并将标志设置为 true。
2) 读一行。
然后,遍历执行 isnumeric
的每个字符,如果没有,则将该字符添加到字符串 Array() 并设置标志,直到再次 isnumeric
,等等....
希望对您有所帮助,或者至少让您朝着正确的方向前进。
你可以试试:
Option Explicit
Sub test()
Dim strToSplit As String, strImport As String
Dim arrwords As Variant
Dim i As Long, counter As Long
With ThisWorkbook.Worksheets("Sheet1")
strToSplit = .Range("A1").Value
arrwords = Split(strToSplit, " ")
counter = 1
For i = LBound(arrwords) To UBound(arrwords)
If IsNumeric(arrwords(i)) = True Then
strImport = arrwords(i)
.Cells(3, counter).Value = strImport
counter = counter + 1
ElseIf Not IsNumeric(arrwords(i)) = True Then
If Not IsNumeric(.Cells(3, counter - 1).Value) Then
strImport = .Cells(3, counter - 1) & " " & arrwords(i)
.Cells(3, counter - 1).Value = strImport
counter = counter
Else
strImport = arrwords(i)
.Cells(3, counter).Value = strImport
counter = counter + 1
End If
End If
Next
End With
End Sub
结果如下所示:
这个基于正则表达式的函数在数字和文本(单词)之间交替进行每次拆分。
Option Explicit
Function customSplit(str As String, _
Optional ndx As Integer = 1) As Variant
Static rgx As Object, cmat As Object
Set rgx = CreateObject("VBScript.RegExp")
With rgx
.Global = True
.MultiLine = True
.IgnoreCase = True
If CBool(ndx Mod 2) Then
.Pattern = "[0-9]{10}"
ndx = (ndx + 1) \ 2
Else
.Pattern = "[A-Z]{1,9}\s[A-Z]{1,9}[\s[A-Z]{1,9}]?"
ndx = ndx \ 2
End If
If .test(str) Then
Set cmat = .Execute(str)
If ndx <= cmat.Count Then
customSplit = cmat.Item(ndx - 1)
End If
End If
End With
End Function
已发布的其他变体:
Sub ZZZ()
Dim dic As Object: Set dic = CreateObject("Scripting.Dictionary")
Dim num$, cl As Range, data As Range, key, x
Dim Result As Worksheet
Set data = Range([A1], Cells(Rows.Count, "A").End(xlUp))
For Each cl In data
x = "": num = "":
For Each x In Split(cl, " ")
If IsNumeric(x) Then
num = x
dic.Add x, ""
ElseIf x <> "" And num <> "" Then
dic(num) = Trim(dic(num) & " " & x)
End If
Next x
Next cl
Set Result = Worksheets.Add
With Result
.Name = "Result " & Replace(Now, ":", "-")
x = 1
For Each key In dic
.Cells(x, "A").Value2 = key
.Cells(x, "B").Value2 = dic(key)
x = x + 1
Next key
.Columns("A:B").AutoFit
End With
End Sub
测试:
如果我将以下信息全部包含在一个单元格中,并且我想将其拆分为单独的单元格。我知道如何使用 space 作为分隔符,但在这种情况下,名称也有 spaces,我希望名称一起留在一个单元格中。更复杂的是,名字并不总是只有名字和姓氏,它还可以包括中间名,因此并不总是标准的两个名字。
2172571122 Jane Doe 3143332222 John Doe
2172242237 Mary Mixer 2223334444 Mike M Martin
希望它最终看起来像这样:
Cell 1 = 2172242237
Cell 2 = Mary Mixer
Cell 3 = 2223334444
Cell 4 = Mike M Martin
有什么建议吗?
关于您可以做什么,我有一些想法。
1) 读一行
执行 split(line, " ")
并循环索引,同时对每个拆分值执行 isNumeric()
。如果不是,则添加到字符串 Array() 并将标志设置为 true。
然后,如果 isnumeric 那么,期望另一个名称并将标志设置为 true。
2) 读一行。
然后,遍历执行 isnumeric
的每个字符,如果没有,则将该字符添加到字符串 Array() 并设置标志,直到再次 isnumeric
,等等....
希望对您有所帮助,或者至少让您朝着正确的方向前进。
你可以试试:
Option Explicit
Sub test()
Dim strToSplit As String, strImport As String
Dim arrwords As Variant
Dim i As Long, counter As Long
With ThisWorkbook.Worksheets("Sheet1")
strToSplit = .Range("A1").Value
arrwords = Split(strToSplit, " ")
counter = 1
For i = LBound(arrwords) To UBound(arrwords)
If IsNumeric(arrwords(i)) = True Then
strImport = arrwords(i)
.Cells(3, counter).Value = strImport
counter = counter + 1
ElseIf Not IsNumeric(arrwords(i)) = True Then
If Not IsNumeric(.Cells(3, counter - 1).Value) Then
strImport = .Cells(3, counter - 1) & " " & arrwords(i)
.Cells(3, counter - 1).Value = strImport
counter = counter
Else
strImport = arrwords(i)
.Cells(3, counter).Value = strImport
counter = counter + 1
End If
End If
Next
End With
End Sub
结果如下所示:
这个基于正则表达式的函数在数字和文本(单词)之间交替进行每次拆分。
Option Explicit
Function customSplit(str As String, _
Optional ndx As Integer = 1) As Variant
Static rgx As Object, cmat As Object
Set rgx = CreateObject("VBScript.RegExp")
With rgx
.Global = True
.MultiLine = True
.IgnoreCase = True
If CBool(ndx Mod 2) Then
.Pattern = "[0-9]{10}"
ndx = (ndx + 1) \ 2
Else
.Pattern = "[A-Z]{1,9}\s[A-Z]{1,9}[\s[A-Z]{1,9}]?"
ndx = ndx \ 2
End If
If .test(str) Then
Set cmat = .Execute(str)
If ndx <= cmat.Count Then
customSplit = cmat.Item(ndx - 1)
End If
End If
End With
End Function
已发布的其他变体:
Sub ZZZ()
Dim dic As Object: Set dic = CreateObject("Scripting.Dictionary")
Dim num$, cl As Range, data As Range, key, x
Dim Result As Worksheet
Set data = Range([A1], Cells(Rows.Count, "A").End(xlUp))
For Each cl In data
x = "": num = "":
For Each x In Split(cl, " ")
If IsNumeric(x) Then
num = x
dic.Add x, ""
ElseIf x <> "" And num <> "" Then
dic(num) = Trim(dic(num) & " " & x)
End If
Next x
Next cl
Set Result = Worksheets.Add
With Result
.Name = "Result " & Replace(Now, ":", "-")
x = 1
For Each key In dic
.Cells(x, "A").Value2 = key
.Cells(x, "B").Value2 = dic(key)
x = x + 1
Next key
.Columns("A:B").AutoFit
End With
End Sub
测试: