Question

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

我想将Numeric和Text值分成两个不同的列，但如果文本包含＆＃34; COL，＆＃34;我想保持＆＃34; COL＆＃34;与数字部分。使用示例数据，预期结果将是：

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

看起来你的所有文字都以BB开头？而且只有两个部分？你有空间，你也试图修剪，但不是修剪，如果他们这样做，你将不会得到BBC的样本输出nn - 你会得到BBCnn。因此，移除阵列循环，在BB处拆分，然后将BB放回到字符串中。

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处的BB分割开始（如果存在）并将其读取到字符串的数字部分的末尾。如果它不存在则在空格处拆分并将拆分限制为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 2

由于我们要拆分 space 字符，我们必须保护 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 3

首先，如果您只想在单个位置划分字符串，则不应该使用拆分，因为这会在找到的每个空格处拆分字符串。我建议使用InStr()查找该案例的COL位置（如果存在），然后使用InStr()查找应将其拆分的位置。

此外，如果表单始终保持一致（特别是它的形式为#### /＃），那么您可以做更多聪明的字符串工作来完成此任务。如果它始终是那种形式，那么我的建议是首先检查COL是否在字符串中。如果找不到（InStr返回0），则只需使用Left()和Right()字符串函数分配B和C列中的值，知道它将始终被分割在第7个值（再次，假设数字形式一致）。如果找到Col，则将字符串从7 + 4值

拆分

Answer 4

另一种更灵活的方法可能是使用Regular Expression。这样，您可以在日期布局发生变化或未来添加新要求时更灵活。

以下是在函数中封装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

单元格中的单独数字和文本

5 个答案: