excel - セル内の検索と置換

Question

私のExcelファイルには次のものがあります：

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

で区切られた任意の範囲の数値-を任意のセルに含めることができます。

特定の列 (任意のセルである可能性があります) で、最初から-ハイフンまでのすべてのテキストを削除したいと考えています。

例: 40-45は45に置き換えられます。

Answer 1

別のアプローチは、正規表現を使用して置換を選択することです

このコードは、操作する範囲を求めるプロンプトを表示します。

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