单独的数字和文本

我正在尝试将列A中的以下types的数据分开：
2814/1 BBx，2814/1 BBSDS，2885/3 BBC nn，2585/3 COL BBC snnn

我想单独将数值和文本值分成两个不同的列，但如果文本包含“COL”，我想保留与数字部分“COL”。 使用示例数据，预期的结果将是：

B列为：2814/1，2814/1，2885 / 3,2585 / 3 COL列C为：BBx，BBSDS，BBC nn，BBC snnn

我有下面的代码，但是它将源文本分成多列，并从数字部分分离COL。

Sub SepNum() Dim N As Long, wf As WorksheetFunction Set wf = Application.WorksheetFunction N = Cells(Rows.Count, "A").End(xlUp).Row Dim i As Long, j As Long, k As Long For i = 1 To N ary = Split(wf.Trim(Cells(i, "A").Text), " ") k = 10 For j = LBound(ary) To UBound(ary) Cells(i, k).Value = ary(j) k = k + 1 Next j Next i End Sub 

Answer 1

既然我们分裂的空间特性，我们必须保护先于COL的空间 ：

 Sub SepNum() Dim N As Long, wf As WorksheetFunction Dim s As String Set wf = Application.WorksheetFunction N = Cells(Rows.Count, "A").End(xlUp).Row Dim i As Long, j As Long, k As Long For i = 1 To N s = Replace(Cells(i, "A").Text, " COL", Chr(2) & "COL") ary = Split(wf.Trim(s), " ") Cells(i, 2).Value = Replace(ary(LBound(ary)), Chr(2), " ") s = "" For j = LBound(ary) + 1 To UBound(ary) s = s & " " & ary(j) Next j Cells(i, 3).Value = wf.Trim(s) Next i End Sub 

编辑＃1：

如果COL之前有多个空格 ，则使用：

 Sub SepNum3() Dim N As Long, wf As WorksheetFunction Dim s As String Set wf = Application.WorksheetFunction N = Cells(Rows.Count, "A").End(xlUp).Row Dim i As Long, j As Long, k As Long For i = 1 To N s = wf.Trim(Cells(i, "A").Text) s = Replace(s, " COL", Chr(2) & "COL") ary = Split(wf.Trim(s), " ") Cells(i, 2).Value = Replace(ary(LBound(ary)), Chr(2), " ") s = "" For j = LBound(ary) + 1 To UBound(ary) s = s & " " & ary(j) Next j Cells(i, 3).Value = wf.Trim(s) Next i End Sub 

Answer 2

看起来你所有的文字都以BB开头？ 只有两个部分？ 你有空间，你也试图修剪，但不修剪，如果他们这样做，你不会结束你的英国广播公司样本输出nn – 你会得到BBCnn而不是。 所以删除数组循环，在BB分裂，然后把BB放回到string。

 Sub SepNum() Dim N As Long, wf As WorksheetFunction Set wf = Application.WorksheetFunction N = Cells(Rows.Count, "A").End(xlUp).Row Dim i As Long, j As Long, k As Long For i = 1 To N ary = Split(wf.Trim(Cells(i, "A").Text), "BB") k = 10 Cells(i, k).Value = ary(0) Cells(i, k + 1).Value = "BB" + ary(1) k = k + 1 Next i End Sub 

或者，如果它们不是都以COL开头，如果它存在并在COL中读取到string的数字部分的末尾。 如果不存在，则在该空间拆分并将拆分限制为2。

 Sub SepNum2() Dim N As Long, wf As WorksheetFunction Set wf = Application.WorksheetFunction N = Cells(Rows.Count, "A").End(xlUp).Row Dim i As Long, j As Long, k As Long For i = 1 To N If InStr(wf.Trim(Cells(i, "A").Text), " COL ") > 0 Then ary = Split(wf.Trim(Cells(i, "A").Text), " COL ", 2) ary(0) = ary(0) + " COL" Else X = wf.Trim(Cells(i, "A").Text) Y = Cells(i, "A").Text ary = Split(wf.Trim(Cells(i, "A").Text), " ", 2)'the 2 limits the split to the first space End If k = 10 For j = LBound(ary) To UBound(ary) Cells(i, k).Value = ary(j) k = k + 1 Next j Next i End Sub 

Answer 3

首先，如果您只想将string分割到一个单独的位置，则不应该使用split，因为这将在每个find的空间处拆分string。 Id推荐使用InStr()来查找COL位置（如果存在的话），然后使用InStr()来查找您应该将其拆分的位置。

另外，如果表单总是一致的（特别是它的forms为#### /＃），那么你可以做更聪明的string工作来完成这个。 如果它始终是这种forms，那么我的build议是首先检查COL是否在string中。 如果找不到（ InStr返回0），那么只需使用Left()和Right() String函数简单地分配B和C列中的值，知道它将始终在第7个值处拆分（再次假设一致的数字形成）。 如果find了列，然后从7 + 4值分割string

Answer 4

另一种更灵活的方法可能是使用Regular Expression 。 这样可以让您在date布局更改时更灵活，或者将来添加新的需求。

下面是RegEx封装在返回匹配数组的函数中的一个例子。 如果不匹配，则只返回“不匹配”。 它包括可选的COL都在相同的模式。

看看它是否可以帮助你。

 Function ExtractVals(sInput As String) As Variant() Dim oReg As Object Dim vMatch() As Variant Dim nCount As Integer Set oReg = CreateObject("VBScript.Regexp") With oReg .IgnoreCase = True .Global = True .Pattern = "(\d*/*\d*\s*(?:COL)?)\s(\w*)" End With If Not oReg.test(sInput) Then ReDim vMatch(0 To 0) vMatch(0) = "No Match" Else With oReg.Execute(sInput)(0) nCount = .submatches.Count - 1 ReDim vMatch(0 To nCount) For i = 0 To nCount vMatch(i) = .submatches(i) Next i End With End If ExtractVals = vMatch End Function Sub test() Dim aMatches() aMatches = ExtractVals(Range("A1").Value) Range("B1").Resize(, UBound(aMatches) + 1).Value = aMatches End Sub 

Answer 5

尝试使用下面的代码

 Sub SepNum() Dim N As Long N = Cells(Rows.Count, "A").End(xlUp).Row Dim i As Long, j As Long, k As Long For i = 1 To N fulllen = Len(Cells(i, 1)) For j = 1 To fulllen If (Asc(Mid(Cells(i, 1), j, 1)) >= 47 And Asc(Mid(Cells(i, 1), j, 1)) <= 57) Or (Asc(Mid(Cells(i, 1), j, 1)) = 44) Then numerals = numerals & Mid(Cells(i, 1), j, 1) Else Text = Text & Mid(Cells(i, 1), j, 1) End If Next j If InStr(Cells(i, 1), "COL") > 0 Then numerals = numerals & " COL" Text = Replace(Text, " COL ", "") End If Cells(i, 2) = numerals Cells(i, 3) = Text Next i End Sub 

---