在单元格内查找和replace

在我的Excel文件中，我有：

A 1 10-30 2 40-45 3 30-80 

在任何单元格中都可以有任何由数字隔开的数字范围。

在任何特定的列（可能是任何单元格），我想从开始到连字符删除所有文本。

例如： 40-45将被replace为45 。

Answer 1

下面的代码将遍历所有工作表及其使用的范围（一个工作簿中所有工作表中的所有单元格），并将仅以string的第二部分（50）replace为以40-80分隔的任何文本

 Sub Main() Application.ScreenUpdating = False Application.EnableEvents = False Dim ws As Worksheet, ur As Range, r As Range For Each ws In Sheets Set ur = ws.UsedRange For Each r In ur On Error Resume Next r = Split(r, "-")(1) Next Next Application.EnableEvents = True Application.ScreenUpdating = True End Sub 

你也可以使用下面的

 Sub MMain() Application.ScreenUpdating = False Application.EnableEvents = False Dim ws As Worksheet, ur As Range, r As Range For Each ws In Sheets Set ur = ws.UsedRange For Each r In ur If Not IsEmpty(r) Then If InStr(1, r.Text, "-", vbTextCompare) Then r = Split(r, "-")(1) End If End If Next Next Application.EnableEvents = True Application.ScreenUpdating = True End Sub 

但在这个特例中，使用第一个例子比第二个例子快了50％。

我已经用100,000个unit testing过它来检查和分割

第一个结果： 2.31 sec
第二个结果： 4.62 sec

Answer 2

另一种方法是使用正则expression式对replace进行select

这段代码会提示你一个范围来操作。

 Sub Update() 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 Set objReg = CreateObject("vbscript.regexp") objReg.Pattern = "\d+\-(\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 '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 text X(lngRow, lngCol) = objReg.Replace(X(lngRow, lngCol), "$1") Next lngCol Next lngRow 'Dump the updated array sans leading whitepace 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