需要删除括号和括号中的数字
我有一个电子表格，其中一列有string数据（名称），后面跟着括号中的数字; 即（9815536）。 这些数字并不是一成不变的。 我需要摆脱括号和括号中的数字。 我已经尝试使用Columns（）。Cells.Replace funtion to no avail。 有没有办法使用正则expression式来做到这一点？ 一个单元格示例如下所示：
Column A John Doe (9815536) Sam Smith (12906) ... 我试过的代码看起来像：
Columns("A:A").Select Selecton.Replace What:="\([0-9]*\), _ Replacement:="", LookAt:=xlPart, SearchOrder:=xlByRows, _ MatchCase:=False, SearchFormat:=False, _ ReplaceFormat:=False
实现这个的一个快速方法是使用
- 一个正则expression式
-
和VBA中的变体数组。
使用代码基于我的文章在Excel VBA中使用Variant数组进行大规模数据处理
Sub KillNumParen() 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 non-number", "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+\)" objReg.Global = True '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 rng1.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), vbNullString) Next lngCol Next lngRow 'Dump the updated array sans leading zeroes 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, vbNullString) End If Next rngArea 'cleanup the Application settings With Application .ScreenUpdating = True .Calculation = lngCalc .EnableEvents = True End With Set objReg = Nothing End Sub