Найти и заменить внутри ячейки

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% быстрее, то второй.

Я испытал его с 100000 клеток, чтобы проверить и разделить

результат для первого: 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