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

您的代码中有几个问题

• 正如Gary所说，您的Function没有返回结果
• 您的Regex.Pattern没有意义
• 您的Sub不会尝试处理多个匹配项
• 您的函数甚至不会尝试返回多个匹配项

---

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