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所说，你的功能没有返回结果
你的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

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

1 个答案: