Tách số dính liền với chữ (1 người xem)

[dtaphuong]

Chào mọi người
Nhờ mọi người giúp mình làm code VBA để có thể tách số dính liền với chữ ra
Ví dụ 0901122333a thành 0901122333

Chi tiết mình có để file đính kèm, trong file cũng đã để sẵn code VBA do mình làm, nhưng code không thể làm được trờng hợp này

Cám ơn các bạn

 

[excel_lv1.5]

Chào mọi người
Nhờ mọi người giúp mình làm code VBA để có thể tách số dính liền với chữ ra
Ví dụ 0901122333a thành 0901122333

Chi tiết mình có để file đính kèm, trong file cũng đã để sẵn code VBA do mình làm, nhưng code không thể làm được trờng hợp này

Cám ơn các bạn

Bạn sửa code lại như vầy xem:

Sub test()
Dim a, i As Long, ii As Long, myCol As Long, m As Object
With Cells(1).CurrentRegion
    Sheet1.Range("D2:D1000000").ClearContents
    a = .Value
    With CreateObject("VBScript.RegExp")
        .Global = True: .Pattern = "\d{9,10}": myCol = 4
        For i = 2 To UBound(a, 1)
            If .test(a(i, 3)) Then
                For ii = 0 To .Execute(a(i, 3)).Count - 1
                    If ii = 0 Then
                        a(i, myCol) = .Execute(a(i, 3))(ii)
                    Else
                        a(i, myCol) = a(i, myCol) & "," & .Execute(a(i, 3))(ii)
                    End If
                Next ii
            End If
        Next i
    End With
    .Resize(, UBound(a, 2)).Value = a
End With
End Sub

 

[TheThienChu]

Bạn sửa code lại như vầy xem:

Option Explicit
Sub test()
Dim a, i As Long, ii As Long, myCol As Long, m As Object
With Cells(1).CurrentRegion
    Sheet1.Range("D2:D1000000").ClearContents
    a = .Value
    With CreateObject("VBScript.RegExp")
        .Global = True: .Pattern = "[^\d\,\s]": myCol = 4
        For i = 2 To UBound(a, 1)
            If .test(a(i, 3)) Then a(i, myCol) = .Replace(a(i, 3), "") & ""
        Next
    End With
    .Resize(, UBound(a, 2)).Value = a
End With
End Sub

D2 Bị thừa dấu "," thì phải

 

[phulien1902]

Chào mọi người
Nhờ mọi người giúp mình làm code VBA để có thể tách số dính liền với chữ ra
Ví dụ 0901122333a thành 0901122333

Chi tiết mình có để file đính kèm, trong file cũng đã để sẵn code VBA do mình làm, nhưng code không thể làm được trờng hợp này

Cám ơn các bạn

Bạn tham khảo:

Function tach(s As String) As String
    With CreateObject("vbscript.regexp")
        .Pattern = "[^0-9,]": .Global = True
        .IgnoreCase = True
        tach = .Replace(s, "")
    End With
End Function

 

[VetMini]

Bạn tham khảo:

Function tach(s As String) As String
    With CreateObject("vbscript.regexp")
        .Pattern = "[^0-9,]": .Global = True
        .IgnoreCase = True
        tach = .Replace(s, "")
    End With
End Function

Function tach(s As String) As String
Static rx As Object
If rx Is Nothing Then
Set rx = CreateObject("vbscript.regexp")
rx.Pattern = "[^0-9,]"
rx.Global = True
rx.IgnoreCase = True
End If
tach = rx.Replace(s, "")
End Function

 

[dtaphuong]

Bạn sửa code lại như vầy xem:

Option Explicit
Sub test()
Dim a, i As Long, ii As Long, myCol As Long, m As Object
With Cells(1).CurrentRegion
    Sheet1.Range("D2:D1000000").ClearContents
    a = .Value
    With CreateObject("VBScript.RegExp")
        .Global = True: .Pattern = "[^\d\,\s]": myCol = 4
        For i = 2 To UBound(a, 1)
            If .test(a(i, 3)) Then a(i, myCol) = .Replace(a(i, 3), "") & ""
        Next
    End With
    .Resize(, UBound(a, 2)).Value = a
End With
End Sub

Thanks bạn code này làm được rồi

 

[excel_lv1.5]

D2 Bị thừa dấu "," thì phải

Đã sửa lại code!!!