查找和小區

Question

內替換我的Excel文件，我有：

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

有可能通過-任何細胞分離的任何數值範圍。

在任何特定列（可能是任何細胞）我想從一開始的所有文本刪除對-連字符。

實施例：40-45將與代替。

Answer 1

下面的代碼將通過所有的工作表和它們的使用的範圍（在一個工作簿中所有片材的所有小區）重複和替換，其由-破折號即40-50僅與串的第二部分分離的任何文本（ 50）

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細胞測試了它來檢查和分裂

結果爲第一個：2.31 sec
結果爲第二個：4.62 sec

Answer 2

另一種方法是使用正則表達式是選擇性關於更換

此代碼將提示您輸入範圍內工作的。

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