刪除不需要的字符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