删除单元格中的所有数字，并在短划线后切断数字
我有一行包含地址示例“GILBERT AZ 85234-4512”的一部分。 我想删除除85234之外的所有字符。所以删除所有的字符，但数字，只保留5位数的邮编。
这需要在循环中完成，因为我有1500多条logging。 如果没有太多的麻烦，它也可以去除任何剩余的空间。
除非在其他地址有一个“ – ”，否则应该起作用。
更新 ：我改变这种情况下没有“ – ”在邮编
Sub findZip() Dim hyphen As String Dim zip As String For Each cell In Range("A2:A1501") hyphen = InStr(1, cell, "-") If hyphen <> 0 Then zip = Trim(Mid(cell, hyphen - 5, 5)) Else: zip = Right(Trim(cell), 5) End If cell.Offset(0, 1) = zip Next End Sub 这可以通过一个RegExp和一个variables数组来最有效地完成（因为范围循环可能非常慢）
从这篇文章
Sub KillNums() Dim rng1 As Range Dim rngArea As Range Dim lngRow As Long Dim lngCol As Long Dim lngCalc As Long Dim objReg As Object Dim X() On Error Resume Next Set rng1 = Application.InputBox("Select range for the replacement of leading zeros", "User select", Selection.Address, , , , , 8) If rng1 Is Nothing Then Exit Sub On Error GoTo 0 'See Patrick Matthews excellent article on using Regular Expressions with VBA Set objReg = CreateObject("vbscript.regexp") objReg.Pattern = "^.+?(\d+)\-.*$" 'Speed up the code by turning off screenupdating and setting calculation to manual 'Disable any code events that may occur when writing to cells With Application lngCalc = .Calculation .ScreenUpdating = False .Calculation = xlCalculationManual .EnableEvents = False End With 'Test each area in the user selected range 'Non contiguous range areas are common when using SpecialCells to define specific cell types to work on For Each rngArea In Intersect(rng1, ActiveSheet.UsedRange).Areas 'The most common outcome is used for the True outcome to optimise code speed If rngArea.Cells.Count > 1 Then 'If there is more than once cell then set the variant array to the dimensions of the range area 'Using Value2 provides a useful speed improvement over Value. On my testing it was 2% on blank cells, up to 10% on non-blanks X = rngArea.Value2 For lngRow = 1 To rngArea.Rows.Count For lngCol = 1 To rngArea.Columns.Count 'replace the leading zeroes X(lngRow, lngCol) = objReg.Replace(X(lngRow, lngCol), "$1") Next lngCol Next lngRow 'Dump the updated array back over the initial range rngArea.Value2 = X Else 'caters for a single cell range area. No variant array required rngArea.Value = objReg.Replace(rngArea.Value, "$1") End If Next rngArea 'cleanup the Application settings With Application .ScreenUpdating = True .Calculation = lngCalc .EnableEvents = True End With Set objReg = Nothing End Sub
快速的方法是select单元格并select查找replace（Ctrl + H）。
首先将-*replace为* ，然后replace* （包括空格）。
这依赖于你的数据格式一致，所以检查结果，如有必要使用撤销/重做。