删除不需要的字符VBA(excel)

我想能够将原始数据复制到列A中,命中运行在macros中,它应该删除我想保留的数据前后的任何不需要的字符导致一个单元格中包含我想要的数据。 我也希望它通过列中的所有单元格,但要记住一些单元格可能是空的。

我想要保留的数据是这种格式: somedata0000somedata000

有时候,在我想保留的数据之前和之后,单元格将包含“垃圾”,即rubbishsomedata0000somedata0000rubbishrubbishsomedata0000rubbish

而且,有时单个单元格将包含:

 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 

我已经把自己的代码放到了目前为止,它所做的只是遍历每个单元格,如果它匹配,就会删除我想要保留的文本以及我想删除的内容! 为什么?

你的代码有几个问题

  • 正如Gary所说,你的Function没有返回结果
  • 你的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