Chiêu 28: Trích xuất dữ liệu số trong 1 chuỗi bằng VBA

Chiêu 28: Trích xuất dữ liệu số trong 1 chuỗi bằng VBA Bạn thường lấy dữ liệu từ nguồn ngoài, chẳng hạn từ Internet, trong đó có dữ liệu số xen lẫn chữ như: “1,254.00VND” hoặc “USD 2,500.00”, thậm chí còn phức tạp hơn. Và cũng có khi bạn đã nhập liệu hỗn hợp text và số không theo quy luật nào để có thể lấy riêng số ra bằng các hàm tách chuỗi thông thường. Dùng 1 hàm tự tạo viết bằng VBA, bạn có thể trích xuất riêng phần số ra, dù cho chuỗi có kiểu dạng gì đi...

Chiêu 28: Trích xuất liệu số chuỗi VBA Bạn thường lấy liệu từ nguồn ngoài, chẳng hạn từ Internet, có liệu số xen lẫn chữ như: “1,254.00VND” “USD 2,500.00”, chí cịn phức tạp Và có bạn nhập liệu hỗn hợp text số không theo quy luật để lấy riêng số hàm tách chuỗi thông thường Dùng hàm tự tạo viết VBA, bạn trích xuất riêng phần số ra, chuỗi có kiểu dạng Bạn nhấn Alt-F11 để vào cửa sổ VBA, insert module dán đoạn code sau vào: PHP Code: Function ExtractNumber(rCell As Range) Dim lCount As Long Dim sText As String Dim lNum As String sText = rCell For lCount = Len(sText) To Step -1 If IsNumeric(Mid(sText, lCount, 1)) Then lNum = Mid(sText, lCount, 1) & lNum End If Next lCount ExtractNumber = CLng(lNum) End Function Vào lại Excel, ô B1 gõ liệu số xen lẫn text tuỳ ý, ô kế bên C1 gõ cơng thức: =ExtractNumber(B1) Ta có kết hình: Comment [1]: BEGIN TEMPLATE: bbcode_php Comment [2]: END TEMPLATE: bbcode_php Bổ sung: Vẫn chút vấn đề: liệu số thập phân ô B5, liệu gồm nhóm số riêng biệt trở lên ô B4, kết không ý muốn Để giải vấn đề số thập phân, ptm0412 có hàm khác: PHP Code: Comment [3]: BEGIN TEMPLATE: bbcode_php Function CtoN(Mystr As String, Optional Dautp As String) As Double Dim Kqng, Kqtp, Neg As Double, Kqtam As String Dim Sotp As Double, Le As Byte Neg = Le = For i = To Len(Mystr) tam = Mid(Mystr, i, 1) Select Case tam Case To Kqtam = Kqtam & tam Case "-" Neg = -1 Case Dautp Kqng = Kqtam Le = Mystr = Right(Mystr, Len(Mystr) - i) Kqtp = CtoN(Mystr) Sotp = Kqtp * 10 ^ (-Len(Kqtp)) End Select Next i Select Case Le Case CtoN = IIf(Kqtam = "", 0, Kqtam) Case CtoN = Kqng + Sotp End Select CtoN = CtoN * Neg End Function Ghi chú:- Khi sử dụng hàm này, bạn thêm vào hàm tham số cho biết dấu thập phân dấu nào, “,” hay “.” Thí dụ =CtoN(“USD 14255.20”,”.”), bạn biết số ngun khơng cần thêm - Hàm đọc số âm ký hiệu số âm dấu trừ đứng trước số Để giải vấn đề nhiều nhóm số khác chuỗi, Ptm0412 có hàm: PHP Code: Comment [4]: END TEMPLATE: bbcode_php Comment [5]: BEGIN TEMPLATE: bbcode_php Function CtoNPlus(Mystr As String, sttchuoi As Byte, Optional Dautp A s String) As Double Newstr = Mystr For i = To sttchuoi If Len(Newstr) < Then Exit For CtoNPlus = CtoN1st(Newstr, Dautp) Next i Newstr = "" End Function PHP Code: Function CtoN1st(ByVal Mystr As String, Optional Dautp As String) As D ouble Dim Kqng, Kqtp, Neg As Double, Kqtam As String Dim Sotp As Double, Le As Byte, NewStr2 As String Neg = Le = For i = To Len(Mystr) tam = Mid(Mystr, i, 1) Select Case tam Case To Kqtam = Kqtam & tam If IsNumeric(Mid(Mystr, i + 1, 1)) = False And _ Mid(Mystr, i + 1, 1) "," And Mid(Mystr, i + 1, 1) "." Th en Newstr = Right(Mystr, Len(Mystr) - i) Exit For End If Case "-" Neg = -1 Case Dautp Kqng = Kqtam Le = NewStr2 = Right(Mystr, Len(Mystr) - i) Kqtp = CtoN1st(NewStr2) Sotp = Kqtp * 10 ^ (-Len(Kqtp)) End Select Next i Select Case Le Case CtoN1st = IIf(Kqtam = "", 0, Kqtam) Case CtoN1st = Kqng + Sotp End Select Comment [6]: END TEMPLATE: bbcode_php Comment [7]: BEGIN TEMPLATE: bbcode_php CtoN1st = CtoN1st * Neg End Function Cú pháp hàm: CtoNPlus(Mystr , sttchuoi, [Dautp]) Sttchuoi số thứ tự nhóm số chuỗi, Dautp ký tự dấu phân cách thập phân Xem file kèm theo Comment [8]: END TEMPLATE: bbcode_php ... Len(Mystr) tam = Mid(Mystr, i, 1) Select Case tam Case To Kqtam = Kqtam & tam If IsNumeric(Mid(Mystr, i + 1, 1) ) = False And _ Mid(Mystr, i + 1, 1) "," And Mid(Mystr, i + 1, 1) "." Th en Newstr... thêm vào hàm tham số cho biết dấu thập phân dấu nào, “,” hay “.” Thí dụ =CtoN(“USD 14 255.20”,”.”), bạn biết số ngun khơng cần thêm - Hàm đọc số âm ký hiệu số âm dấu trừ đứng trước số Để giải vấn... "-" Neg = -1 Case Dautp Kqng = Kqtam Le = NewStr2 = Right(Mystr, Len(Mystr) - i) Kqtp = CtoN1st(NewStr2) Sotp = Kqtp * 10 ^ (-Len(Kqtp)) End Select Next i Select Case Le Case CtoN1st = IIf(Kqtam