0

在我的 Excel 文件中,我有:

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

在任何单元格中可以有任何范围的数字分隔-

在任何特定列(可能是任何单元格)中,我想删除从开头到-连字符的所有文本。

示例:40-45将替换为45

4

2 回答 2

2

下面的代码将遍历所有工作表及其使用的范围(一个工作簿中所有工作表中的所有单元格)并替换由- 破折号分隔的任何文本, 即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

于 2013-09-26T09:13:09.490 回答
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
于 2013-09-26T09:58:31.360 回答