使用VBA拆分Excel文本、数字、变量清除器

我有一个非常大的“工作请求”数据集需要清理。数据集有一些一致的元素，一系列的数字是一个集合长度。这个长度在数据集的一半左右变化，但变化是可预测的。数据集的一个问题是，有多个去离子器，有时没有去离子器，有时前面有文本等。我提取了一个我正在处理的变量样本，并手动将它们分离，以显示所需的结果

+----+--------------------------------+------------+--------+----------------------+
|    |               A                |     B      |   C    |          D           |
+----+--------------------------------+------------+--------+----------------------+
|  1 | Work Request                   | Cell 1     | Cell 2 | Cell 3               |
|  2 | 2097947.A                      | 2097947    | A      |                      |
|  3 | 2590082.A/4900 REPLACE DXAC    | 2590082    | A      | 4900 Replace DXAC    |
|  4 | 2679314.C                      | 2679314    | C      |                      |
|  5 | 2864142B/DEMOLISH STRUCTURES   | 2864142    | B      | DEMOLISH STRUCTURES  |
|  6 | 3173618                        | 3173618    |        |                      |
|  7 | 3251628/4800 REPLACE ASPHALT   | 3251628    |        | 4800 REPLACE ASPHALT |
|  8 | 4109066A                       | 4109066    | A      |                      |
|  9 | 4374312D                       | 4374312    | D      |                      |
| 10 | 4465402, Building 4100         | 4465402    |        | Building 4100        |
| 11 | 4881715 DESIGN                 | 4881715    |        | DESIGN               |
| 12 | 4998608\                       | 4998608    |        |                      |
| 13 | ADMIN                          | ADMIN      |        |                      |
| 14 | PGM MGMT                       | PGM MGMT   |        |                      |
| 15 | FWR # 4958989 /Bldg 4000       | 4958989    |        | Bldg 4000            |
| 16 | NICC FEDISR000744416/4000 UPS  | R000744416 |        | 4000 UPS             |
| 17 | R000451086/4300 MODS TO RM5006 | R000451086 |        | 4300 MODS TO RM5006  |
+----+--------------------------------+------------+--------+----------------------+

正如您所看到的，有一些可预测的变量，还有一些是用户输入错误。 请注意，在某些情况下，数字在7位工作请求编号后面有一个单一字符，大多数情况下用“.”分隔，但有时没有像A8和A9那样的分隔。有时会有去污剂“/”或“空格”或“，”但这并不一致。我目前正在使用一个VBA，该VBA能够成功地为一些人去除数字，但在遇到没有数字或额外数字时失败。最终，工作请求编号被更改为添加R00，这是“新”编号，超过一半的数据以某种形式使用此编号

我正在使用的VBA：

Option Explicit
Public Function Strip(ByVal x As String, LeaveNums As Boolean) As Variant
Dim y As String, z As String, n As Long
    For n = 1 To Len(x)
        y = Mid(x, n, 1)
        If LeaveNums = False Then
            If y Like "[A-Za-z ]" Then z = z & y 'False keeps Letters and spaces only
        Else
            If y Like "[0-9. ]" Then z = z & y   'True keeps Numbers and decimal points
        End If
    Next n
Strip = Trim(z)
End Function

这在某些地方有效，但在其他地方无效。它也没有分别分开C和D。最重要的问题是剥离工作请求编号，如B所示

谢谢您的帮助。

试试这段代码

Private Sub UserForm_Click()
    Dim Sp() As String: Sp = Split(Strip("2590082.A/4900 REPLACE DXAC"), "|")
    Sheet1.Range("B2", Sheet1.Cells(RowIndex:=2, ColumnIndex:=UBound(Sp) + 2)).Value = Sp
End Sub

Function Strip(s As String) As String
    If s = "" Then Exit Function
    Dim tmp As String
    tmp = s
    Dim Sp() As String: Sp = Split("0,1,2,3,4,5,6,7,8,9,.", ",")
    For i = 0 To 10
        tmp = Replace(tmp, Sp(i), "|")
    Next
    Dim words As String
    Sp = Split(tmp, "|")
    For i = 0 To UBound(Sp)
        If Sp(i) <> "" Then words = words & Sp(i) & "|"
    Next
    If Right$(words, 1) = "|" Then words = Mid(words, 1, Len(words) - 1)
    
    tmp = s
    Sp = Split(words, "|")
    
    For i = 0 To UBound(Sp)
        tmp = Replace(tmp, Sp(i), "|" & Sp(i) & "|")
    Next
    If Right$(tmp, 1) = "|" Then tmp = Mid(tmp, 1, Len(tmp) - 1)
    Strip = tmp
End Function

Private子用户表单_Click（）
尺寸Sp（）作为字符串：Sp=Split（条带（“2590082.A/4900替换DXAC”），“|”）
Sheet1.范围（“B2”，Sheet1.单元格（行索引：=2，列索引：=UBound（Sp）+2））。值=Sp
端接头
功能条（作为字符串）作为字符串
如果s=”“，则退出函数
将tmp设置为字符串
tmp=s
Dim Sp（）作为字符串：Sp=Split（“0,1,2,3,4,5,6,7,8,9，，，，”）
对于i=0到10
tmp=替换（tmp，Sp（i），“|”）
下一个
字串
Sp=拆分（tmp，“|”）的
对于i=0至UBound（Sp）
如果Sp（i）“，则单词=单词&Sp（i）&”
下一个
如果右$（words，1）=“|”，则words=Mid（words，1，Len（words）-1）
tmp=s
Sp=拆分（文字“|”）
对于i=0至UBound（Sp）
tmp=替换（tmp，Sp（i），“|”和Sp（i）和“|”）
下一个
如果右$（tmp，1）=“|”，则tmp=Mid（tmp，1，Len（tmp）-1）
条带=tmp
端函数

下面是一个使用正则表达式的示例

Sub WorkRequests()
    
    Dim re As Object, allMatches, m, rv, sep, c As Range
    
    Set re = CreateObject("VBScript.RegExp")
    re.Pattern = "(((R00)?\d{7})[\.]?([A-Z])?)"
    re.ignorecase = True
    re.MultiLine = True
    re.Global = True
    
    For Each c In Range("B5:B20").Cells 'for example
        c.Offset(0, 1).Resize(1, 3).ClearContents 'clear output cells
        If re.test(c.Value) Then
            Set allMatches = re.Execute(c.Value)
            For Each m In allMatches
                c.Offset(0, 1).Value = m 'order#+letter
                c.Offset(0, 2).Value = m.submatches(1) 'order #
                c.Offset(0, 3).Value = m.submatches(3) 'letter
            Next m
        End If
    Next c
    
End Sub

---

正则表达式引用：

这是一个使用正则表达式的函数，它返回一个结果数组

Option Explicit
'Set reference to Microsoft VBScript Regular Expressions 5.5
'  or use late binding
Function Splitter(S As String) As String()
    Dim re As RegExp, MC As MatchCollection
    Const sPat As String = "^(?:\D*?(?=R?\d)(R?\d+)[,.]?([A-Z])?\s*[/\\]?\s*(.*\S)?)|\s*(.*\S)"
    Dim sTemp(2) As String
    
Set re = New RegExp
With re
    .Global = True
    .MultiLine = True
    .Pattern = sPat
    If .Test(S) = True Then
        Set MC = .Execute(S)
        With MC(0)
            sTemp(0) = .SubMatches(0) & .SubMatches(3)
            sTemp(1) = .SubMatches(1)
            sTemp(2) = .SubMatches(2)
        End With
    Splitter = sTemp
    End If
End With
    
End Function

使用

A2:An

中的数据，如果您有带动态数组的Excel O365，则可以输入：

B2:  =Splitter(A2)

然后填好。数组的结果将直接溢出到列

C

和

D

如果没有动态数组，则：

B2: =INDEX(Splitter($A2),COLUMNS($A:A))

向右填充到

D2

。然后选择B2:D2，并根据需要填写

---

感谢您提供的解决方案。我在尝试使用代码时出错。我得到的错误是“检测到不明确的名称：拆分器”。我确保已选择正则表达式的VBA引用，但无法使任何内容正常工作。我会注意到，在意识到RegExp在MAC上不工作之前，我在MAC上启动了，所以我切换到了我的Windows机器，上面的错误是在那个版本上。都是O365。我不太擅长VBA，所以非常感谢您的帮助！更新：我将相同的东西粘贴到两个模块中，但没有注意到第二个模块。我将继续修补它，但它看起来像它现在正在工作！

B2: =INDEX(Splitter($A2),COLUMNS($A:A))