셀에서 숫자를 제외한 모든 숫자를 제거하고 대시 후 숫자를 자름

Question

주소 예 "GILBERT AZ 85234-4512"의 일부가 포함 된 행이 있습니다. 85234 이외의 모든 문자를 제거하고 싶습니다. 따라서 숫자 만 제외하고 숫자를 모두 지우고 5 자리 우편 번호 만 유지하십시오.

1500 개 이상의 레코드가 있으므로 루프를 반복해야합니다. 너무 많은 문제가 아니라면 남은 공간을 모두 제거하십시오.

Answer 1

다른 곳에 주소에 "-"가 없으면이 기능이 작동합니다. 업데이트

: 나는 아니오 경우에이 변경 "-"가 된 우편 번호

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 

Answer 2

빠른 방법은 셀을 선택하고 찾기 - 바꾸기 (Ctrl + H)를 선택하는 것입니다.

먼저 -*을 아무 것도 붙이지 않은 다음 *  (공백 포함)을 아무 것도 대치하지 마십시오.

데이터의 형식이 일관되게 유지되므로 결과를 확인하고 필요한 경우 실행 취소/다시 실행을 사용하십시오.

Answer 3

이 범위 루프가 될 수 있습니다로 RegExp 및 변형 배열 (함께 가장 효율적으로 수행 할 것입니다 매우 내가 그렇게 VBS에 필요한

this article

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