1

我有一行包含地址示例“GILBERT AZ 85234-4512”的一部分。我想删除除 85234 以外的所有字符。因此，删除除数字以外的所有字符，只保留 5 位数的 zip。

这需要循环完成，因为我有 1500 多条记录。如果它不是太麻烦的话，它也可以删除任何剩余的空间。

4

3 回答 3

1

这将使用一个RegExp和一个变体数组最有效地完成（因为范围循环可能非常慢）

从这篇文章

Sub KillNums()
    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

    'See Patrick Matthews excellent article on using Regular Expressions with VBA
    Set objReg = CreateObject("vbscript.regexp")
    objReg.Pattern = "^.+?(\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

    'Test each area in the user selected range

    'Non contiguous range areas are common when using SpecialCells to define specific cell types to work on
    For Each rngArea In Intersect(rng1, ActiveSheet.UsedRange).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 the leading zeroes
                    X(lngRow, lngCol) = objReg.Replace(X(lngRow, lngCol), "$1")
                Next lngCol
            Next lngRow
            'Dump the updated array 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
于 2012-06-08T01:32:59.040 回答
0

一种快速的方法是选择单元格并选择查找-替换 (Ctrl+H)。

首先-*用 nothing 替换，然后用 nothing 替换* （包括空格）。

这取决于您的数据格式是否一致，因此请检查结果并在必要时使用撤消/重做。

于 2012-06-07T16:09:43.170 回答
0

除非其他地方的地址中有“-”，否则这应该有效。

更新：我对邮政编码中没有“-”的情况进行了更改

    Sub findZip()
Dim hyphen As String
Dim zip As String
    For Each cell In Range("A2:A1501")
        hyphen = InStr(1, cell, "-")
        If hyphen <> 0 Then
         zip = Trim(Mid(cell, hyphen - 5, 5))
         Else: zip = Right(Trim(cell), 5)
         End If
        cell.Offset(0, 1) = zip
    Next
End Sub
于 2012-06-07T16:53:01.597 回答