Rút gọn giúp em đoạn code này (2 người xem)

[kimhuynh]

Em có một danh sách số điện thoại của khách hàng nhưng không được cập nhật đúng theo chuẩn, nay muốn cập nhật lại, em dùng Marco để xoá các ký tự dư thừa, các khoảng trắng, nhưng code em viết dài dòng quá. Bro nào giúp em chỉnh sửa lại cho ngắn bớt với.

Yêu cầu: Tìm và xoá hết các ký tự khác trong range "A1:A18", chỉ giữ lại các số từ 0 đến 9 thôi. Xoá luôn cả khoản trắng.

Đoạn code:
Sub Macro1()
'
' Macro1 Macro
'
' Keyboard Shortcut: Ctrl+k
'
Range("A1:A18").Select
Range("A9").Activate
Selection.Replace What:="-", Replacement:="", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
Selection.Replace What:=".", Replacement:="", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False

End Sub

 

[sealand]

Tạm như thế này

Sub Macro1()
With Range("A1:A18")
.Replace What:="-", Replacement:="", LookAt:=xlPart
.Replace What:=".", Replacement:="", LookAt:=xlPart
End With
End Sub

 

[kimhuynh]

Dear bac Sealand

Bác rút gọn cho em được chỉ có 2 ký tự "." và "-" thôi. Còn các ký tự khác từ A đến Z, các ký tự đặt biệt như @, #,$, (,) ....v.v thì sao nhỉ?

Chẳng lẻ em phải copy đến hơn 30 dòng và gõ vào:
.Replace What:="a", Replacement:="", LookAt:=xlPart
................
.Replace What:="z", Replacement:="", LookAt:=xlPart
.........
.Replace What:="@", Replacement:="", LookAt:=xlPart

Như thế vẫn chưa rút gọn được bác à. Có code nào mà xóa hết tất cả các ký tự và chỉ chừa lại các số từ 0 đến 9 không?

cám ơn Bác truớc nhé.

 

[ndu96081631]

Dear bac Sealand

Bác rút gọn cho em được chỉ có 2 ký tự "." và "-" thôi. Còn các ký tự khác từ A đến Z, các ký tự đặt biệt như @, #,$, (,) ....v.v thì sao nhỉ?

Chẳng lẻ em phải copy đến hơn 30 dòng và gõ vào:
.Replace What:="a", Replacement:="", LookAt:=xlPart
................
.Replace What:="z", Replacement:="", LookAt:=xlPart
.........
.Replace What:="@", Replacement:="", LookAt:=xlPart

Như thế vẫn chưa rút gọn được bác à. Có code nào mà xóa hết tất cả các ký tự và chỉ chừa lại các số từ 0 đến 9 không?

cám ơn Bác truớc nhé.

Tặng bạn code này:

Function GetNum(ByVal Text As String)
  With CreateObject("VBScript.RegExp")
    .Global = True: .Pattern = "\D"
    GetNum = .Replace(Text, "")
  End With
End Function

Sub RemoveString()
  Dim TmpArr, i As Long, j As Long
  TmpArr = Selection
  Selection.NumberFormat = "@"
  For i = LBound(TmpArr, 1) To UBound(TmpArr, 1)
    For j = LBound(TmpArr, 2) To UBound(TmpArr, 2)
      If TmpArr(i, j) <> "" Then TmpArr(i, j) = GetNum(TmpArr(i, j))
    Next
  Next
  Selection.Value = TmpArr
End Sub

Tại file đính kèm về, quét chọn vùng dữ liệu rồi bấm tổ hợp phím Ctrl + Shift + R

 

[kimhuynh]

Cảm ơn anh NDU rất nhiều. Đúng là cái này em cần để xử lý.