删除不需要的字符VBA（excel）

Question

我希望能够将原始数据复制到列A中，命中宏上的运行，并且它应该在我希望保留的数据前后都删除任何不需要的字符，从而产生单元格只是包含我想要的数据。我也希望它通过列中的所有单元格，但要记住一些单元格可能为空。

，我想保持数据的格式如下：somedata0000或somedata000

有时单元格将包含“垃圾”之前和我想保持数据后，即rubbishsomedata0000或somedata0000rubbish或rubbishsomedata0000rubbish。

，并且有时一个单单元格将包含：

rubbishsomedata0000rubbish 
rubbishsomedata0000rubbish 
rubbishsomedata0000rubbish 

这将需要更改为：

NEW CELL: somedata0000 
NEW CELL: somedata0000 
NEW CELL: somedata0000 

的 'somedata' 文本不会改变，但在0000（可能是任何4个数字）有时会是任何3个数字。

此外，列中可能有一些行没有有用的数据;这些应该从工作表中删除/删除。

最后，一些单元格将包含完美的somedata0000，这些应该保持不变。

Sub Test() 
    Dim c As Range 
    For Each c In Range("A2:A" & Range("A" & Rows.Count).End(xlUp).Row) 
     c = removeData(c.text) 
    Next 
    End Sub 

    Function removeData(ByVal txt As String) As String 
    Dim result As String 
    Dim allMatches As Object 
    Dim RE As Object 

    Set RE = CreateObject("vbscript.regexp") 

    RE.Pattern = "(somedata-\d{4}|\d{3})" 
    RE.Global = True 
    RE.IgnoreCase = True 
    Set allMatches = RE.Execute(text) 

    If allMatches.Count <> 0 Then 
     result = allMatches.Item(0).submatches.Item(0) 
    End If 

    ExtractSDI = result 

    End Function 

我已经把我的代码，我已经这么远，它是所有经过的每个细胞，如果它匹配它只是删除，我想保留，以及我想要的东西，文字删除！为什么？

Answer 1

有在你的代码的几个问题

• 正如加里说，你的功能是没有返回结果
• 您Regex.Pattern无厘头
• 您的次级不会尝试处理多个匹配
• 您的函数甚至没有尝试返回多个匹配

---

Sub Test() 
    Dim rng As Range 
    Dim result As Variant 
    Dim i As Long 

    With ActiveSheet 
     Set rng = Range(.Cells(2, 1), .Cells(.Rows.Count, 1).End(xlUp)) 
    End With 
    For i = rng.Rows.Count To 1 Step -1 
     result = removeData(rng.Cells(i, 1)) 
     If IsArray(result) Then 
      If UBound(result) = 1 Then 
       rng.Cells(i, 1) = result(1) 
      Else 
       rng.Cells(i, 1).Offset(1, 0).Resize(UBound(result) - 1, 1).Insert xlShiftDown 
       rng.Cells(i, 1).Resize(UBound(result), 1) = Application.Transpose(result) 
      End If 
     Else 
      rng.Cells(i, 1).ClearContents 
     End If 
    Next 
End Sub 

Function removeData(ByVal txt As String) As Variant 
    Dim result As Variant 
    Dim allMatches As Object 
    Dim RE As Object 
    Dim i As Long 

    Set RE = CreateObject("vbscript.regexp") 

    RE.Pattern = "(somedata\d{3,4})" 
    RE.Global = True 
    RE.IgnoreCase = True 
    Set allMatches = RE.Execute(txt) 

    If allMatches.Count > 0 Then 
     ReDim result(1 To allMatches.Count) 
     For i = 0 To allMatches.Count - 1 
      result(i + 1) = allMatches.Item(i).Value 
     Next 
    End If 
    removeData = result 
End Function