如何使用excel VBA脚本删除某些字符
下面的VBA脚本摆脱不需要的字符，但不幸的是只有NUMBERS。
你能帮我吗？它也需要去掉字母，如下面的表格（粗体）所示。
范围可以是从0到15000+单元的任何地方
………………………………………….. …
一个新的约克一次
b新byork b次b
c新c纽约c水城c纽约c
6月 6日新6约克6城6
………………………………………….. ….
VBA脚本：
Sub Remove() Application.ScreenUpdating = False Dim R As RegExp, C As Range For Each C In Range("A1:A" & Cells(Rows.Count, 1).End(xlUp).Row) If R Is Nothing Then Set R = New RegExp R.Global = True R.Pattern = "\D" C.Offset(0, 1) = R.Replace(C, "") R.Pattern = "\d" C = R.Replace(C, "") End If Set R = Nothing Next C Application.ScreenUpdating = True End Sub EDIT1
Sub Remove() Call BackMeUp Dim cell As Range Dim RE As Object Dim Whitecell As Range Dim strFind As String, strReplace As String Dim lLoop As Long Dim Loop1 As Long Application.ScreenUpdating = False Application.Calculation = xlCalculationManual Application.EnableEvents = False Range("A3:L3").Select Selection.Delete Shift:=xlUp '--------------------------------------------------Remove JUNK Range("A3:A" & Cells(Rows.Count, 1).End(xlUp).Row).Select On Error Resume Next For lLoop = 1 To 100 strFind = Choose(lLoop, "~?»", "~®", "~.", "~!", "~ï", "~-", "~§", "~$", "~%", "~&", "~/", "~\", "~,", "~(", "~)", "~=", "~www", "~WWW", "~.com", "~.net", "~.org", "~{", "~}", "~[", "~]", "~ï", "~¿", "~½", "~:", "~;", "~_", "~µ", "~@", "~#", "~'", "~|", "~€", "~ä", "~ö", "~ü", "~Ä", "~Ü", "~Ö", "~+", "~<", "~>", "~nbsp", "~â", "~¦", "~©", "~Â", "~–", "~¼", "~?") strReplace = Choose(lLoop, " ") Selection.Replace What:=strFind, Replacement:=strReplace, LookAt:=xlPart, _ SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _ ReplaceFormat:=False Next lLoop '--------------------------------------------------Remove Numbers Range("A3:A" & Cells(Rows.Count, 1).End(xlUp).Row).Select On Error Resume Next For Loop1 = 1 To 40 strFind = Choose(lLoop, "~1", "~2", "~3", "~4", "~5", "~6", "~7", "~8", "~9", "~0") strReplace = Choose(Loop1, " ") Selection.Replace What:=strFind, Replacement:=strReplace, LookAt:=xlPart, _ SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _ ReplaceFormat:=False Next Loop1 '--------------------------------------------------Remove Single Letters Set RE = CreateObject("vbscript.regexp") RE.Global = True RE.MultiLine = True RE.Pattern = "^[az]\b | \b[az]\b" For Each cell In Range("A3:A" & Cells(Rows.Count, 1).End(xlUp).Row) cell.Value = RE.Replace(cell.Value, "") Next '--------------------------------------------------Remove WHITE SPACES For Each Whitecell In Range("A3:A" & Cells(Rows.Count, 1).End(xlUp).Row) Whitecell = WorksheetFunction.Trim(Whitecell) Next Whitecell '--------------------------------------------------Remove DUPES ActiveSheet.Range("A3:A" & Cells(Rows.Count, 1).End(xlUp).Row).RemoveDuplicates Columns:=1, Header:=xlYes ActiveWorkbook.Worksheets(ActiveSheet.Name).Sort.SortFields.Clear '--------------------------------------------------Copy to B - REPLACE ALL WHITE IN B Range("A3:A" & Cells(Rows.Count, 1).End(xlUp).Row).Select Selection.Copy Range("B3:B" & Cells(Rows.Count, 1).End(xlUp).Row).Select ActiveSheet.Paste Selection.Replace What:=" ", Replacement:="", LookAt:=xlPart, _ SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _ ReplaceFormat:=False Columns("A:L").EntireColumn.AutoFit '--------------------------------------------------END Application.ScreenUpdating = True Application.Calculation = xlCalculationAutomatic Application.EnableEvents = True Range("a1").Select End Sub
编辑 （ 删除原来的答案，因为它是不适用后收到你想要什么，但离开build议更多的信息）
- 您正在创build/销毁RE对象的每个单元格，这是昂贵的/不合适的
- 如果其他用户将使用该函数，则在代码中创build对象而不是添加引用
- 没有必要在最后设置regex对象为空 – variables从函数结尾的内存中自动释放
- 改进variables命名和使用适当的缩进可以帮助提高可读性并使其更易于编辑
- 添加多行选项，以防您的单元格内有换行符。
- 如果使用大量的单元格，可能需要使用variables数组
UDPATE 2
根据下面的评论，这里是如何获得两个或两个以上的小写字符和中间的单个空格。 而不是取代你不想要的，我个人认为一个好方法是提取你想要的。 我在这个网站上分享了下面的function，因为它非常有用。 下面是一个如何在列A的内容上调用它并将结果放在列B中的例子。
Sub test() ' Show how to run this on cells in A and transpose result in B Dim varray As Variant Dim i As Long Application.ScreenUpdating = False varray = Range("A1:A15000").Value For i = 1 To UBound(varray, 1) varray(i, 1) = RegexExtract(varray(i, 1), "([az]{2,})", " ") Next Range("B1").Resize(UBound(varray, 1)).Value = _ Application.WorksheetFunction.Transpose(varray) Application.ScreenUpdating = True End Sub
并确保这是在模块中：
Function RegexExtract(ByVal text As String, _ ByVal extract_what As String, _ Optional seperator As String = "") As String Dim i As Long Dim j As Long Dim result As String Dim allMatches As Object Dim RE As Object Set RE = CreateObject("vbscript.regexp") RE.Pattern = extract_what RE.Global = True Set allMatches = RE.Execute(text) For i = 0 To allMatches.Count - 1 For j = 0 To allMatches.Item(i).submatches.Count - 1 result = result & seperator & allMatches.Item(i).submatches.Item(j) Next Next If Len(result) <> 0 Then result = Right$(result, Len(result) - Len(seperator)) End If RegexExtract = result End Function
您的“R.Pattern =”\ d“是您需要更改的唯一行，”\ d“是描述”数字“的正则expression式。
我build议将“\ d”改为“^ [a-z0-9] | [a-z0-9] \ b”作为起点。
我在下面重写了你的代码
- RegExp只创build一次。 你当前的代码创build一个新的对象，然后破坏它为每个被testing的单元格，因为它是在你的循环内
- 下面的代码使用variables数组来最小化处理每个单元格值时的处理时间。 常量
VbNullString比“”稍快。 - 你使用正则expression式中的简单\ w来匹配任何a-z0-9
-
在RegExp对象上的后期绑定可避免需要第三方设置引用，将忽略大小写设置为true会使replace大小写不敏感
Sub Remove() Dim R As Object Dim C As Range Dim lngrow As Long Dim rng1 As Range Dim X Set R = CreateObject("vbscript.regexp") With R .Global = True .Pattern = "^\w\s|\b\w\b" .ignoreCase = True End With Application.ScreenUpdating = False Set rng1 = Range("A1:A" & Cells(Rows.Count, 1).End(xlUp).Row) X = rng1.Value2 For lngrow = 1 To UBound(X, 1) X(lngrow, 1) = R.Replace(X(lngrow, 1), vbNullString) Next lngrow rng1.Value2 = X Application.ScreenUpdating = True End Sub