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