TÁCH ĐOẠN CHỮ SỐ TRONG ĐOẠN TEXT

Liên hệ QC
Tôi rất cảm ơn bạn, tôi thấy nó bóc tách ID của khách hàng rất chính xác.
Nhưng hình như nó có 2 lỗi :
1- nếu ô đầu tiên của hàng đầu không có cấu trúc như dữ liệu hoặc trống, hoặc nhãn của cột thì nó không chạy và báo lỗi.
2- Nếu dữ liệu quá lớn, ví dụ như dữ liệu lên đến 35 ngàn dòng thì nó cũng báo lỗi và không chạy được.
Tôi cũng không chắc là bao nhiêu thì nó báo lỗi, nhưng tôi đã làm đến 2000 dữ liệu thì thấy nó vẫn chạy tốt, ngoại trừ lỗi 1.
Ước gì bạn cố công thêm 1 tý giúp tôi cho trót luôn nhé
Cảm ơn bạn quá sức nhiều ! 'thanks thanks thanks thanks thanks thanks thanks thanks thanks thanks
Bạn chỉnh code lại như vầy:
PHP:
Sub idcustomer()
Dim i As Long, arr, result
arr = Range("a1:a" & Cells(Rows.Count, "A").End(xlUp).Row)
ReDim result(1 To UBound(arr), 1 To 1)
With CreateObject("vbscript.regexp")
    .Pattern = "\d{4,8}"
    For i = 1 To UBound(arr)
        if .test(arr(i, 1)) then result(i, 1) = .Execute(arr(i, 1))(0)
    Next i
End With
[b1].Resize(UBound(arr)) = result
End Sub
Nếu không có sẽ trả về rỗng!!!
 
Bạn chỉnh code lại như vầy:
PHP:
Sub idcustomer()
Dim i As Long, arr, result
arr = Range("a1:a" & Cells(Rows.Count, "A").End(xlUp).Row)
ReDim result(1 To UBound(arr), 1 To 1)
With CreateObject("vbscript.regexp")
    .Pattern = "\d{4,8}"
    For i = 1 To UBound(arr)
        if .test(arr(i, 1)) then result(i, 1) = .Execute(arr(i, 1))(0)
    Next i
End With
[b1].Resize(UBound(arr)) = result
End Sub
Nếu không có sẽ trả về rỗng!!!


quá hay bạn ơi. nó chạy rất chuẩn luôn. Tôi chạy cho 78000 dòng dữ liệu mà thấy không có lỗi nào cả
thanks bạn rất nhiều.
Marco rất ngắn mà chạy rất hiệu quả
 
Web KT
Back
Top Bottom