Nếu dùng hàm thì sợ ko chuẩn vì giá trị số trước và sau X có thay đổi (nó có thể là 1 , 2, 3,... Kí tự số không phải là số nhất định 2 hay 3 kí tự) nên mình nghĩ macro mới giải quyết chính xác đc
Em đã làm bài này rồi, nhưng vì bài này có từ viết tắt nên lại xóa đi cho đỡ nặng máy anh ạ.
Bạn chưa tham khảo các thớt nói về "tách họ và tên" cho nên mới có thành kiến như vậy.
Tôi đã nói tôi lười viết code mà.
Em gửi nhầm file, mục đích của Em cần xử lý dữ liệu như file đã lược bỏ các dòng không cần xử lý rồi ạTôi đã nói tôi lười viết code mà.
Đối với người thích code thì cứ thao tác vài lượt tay là coi như khó.
Đối với tôi thằng lính nào làm việc nhanh quá thì có lẽ do ban đầu mình định độ khó công việc sai lầm. Sếp của nó cần giao thêm công việc cho nó.
Chạy code:
Sub TachSo()
Dim FChr&, i&, iSt&, iC&, iCl&
Dim aData, aRes, sSrc$
aData = Range("C6", "C" & Range("C" & Rows.Count).End(xlUp).Row).Value
ReDim aRes(1 To UBound(aData), 1 To 4)
iSt = 1: iC = 1
For i = 1 To UBound(aData)
FChr = IIf(IsNumeric(Mid(Trim(aData(i, 1)), 2, 1)), 2, 3)
sSrc = Trim(Right(Trim(aData(i, 1)), Len(Trim(aData(i, 1))) - FChr + 1))
sSrc = Replace(sSrc, "*", "X")
Do While InStr(iSt, sSrc, "X")
iCl = IIf(iC = 2, 3, IIf(iC = 3, 2, iC))
aRes(i, iCl) = Mid(sSrc, iSt, InStr(iSt, sSrc, "X") - iSt)
iC = iC + 1: iSt = InStr(iSt, sSrc, "X") + 1
Loop
aRes(i, 4) = Mid(sSrc, iSt): iSt = 1: iC = 1
Next
Range("R6").Resize(UBound(aRes), 4).Value = aRes
End Sub
Công thức tại M6, tự sửa thêm cho phù hợp với nhu cầu:
=TRIM(MID(SUBSTITUTE(SUBSTITUTE(C6,"BH","X"),"X",REPT(" ",100)),100,100))
Public Function Tach4So(s As String) As Variant
'Chi tach chuoi co 4 so
Dim i&, tmp$, arr As Variant
For i = 1 To Len(s)
If IsNumeric(Mid(s, i, 1)) Then
s = Mid(s, i)
Exit For
End If
Next i
arr = Split(Replace(UCase(s), "*", "X"), "X")
If UBound(arr) = 3 Then
tmp = arr(1)
arr(1) = arr(2)
arr(2) = tmp
Tach4So = arr
End If
End Function
Thêm 1 cách nữa cho bạn tham khảo.
Option Explicit
Function ExtractChar(text As Variant, iType As String)
Dim Tmp 'As String
Tmp = Switch(iType = "L", "[^a-zA-Z]", iType = "N", "[^0-9]", iType = "S", "[0-9a-zA-Z]")
With CreateObject("VBScript.RegExp")
.Global = True: .Pattern = Tmp
ExtractChar = .Replace(text, "")
End With
End FunctionOption Explicit
Sub Tach()
Dim i&, j&, S, Tmp, Temp, Lr&
Dim Arr(), KQ()
Dim Sh As Worksheet
Set Sh = Sheet1
Lr = Sh.Cells(100000, "C").End(xlUp).Row
Arr = Sh.Range("C6:C" & Lr)
ReDim KQ(1 To UBound(Arr), 1 To 4)
For i = 1 To UBound(Arr)
Temp = Replace(Arr(i, 1), "X", " ")
S = Split(Temp, " ")
KQ(i, 1) = ExtractChar(S(0), "N")
KQ(i, 2) = ExtractChar(S(2), "N")
KQ(i, 3) = ExtractChar(S(1), "N")
KQ(i, 4) = ExtractChar(S(3), "N")
'Sheet1.Cells(i + 1, (j * 2) + 18) = ExtractChar(Tmp, "N")
'Next j
Next i
Sheet1.Range("R6").Resize(i, 4) = KQ
End SubConcat theo ghi chú của Microsoft là từ bản 2016, mà không biết là phiên bản nào. Mấy bản 2016 mình dùng đều không thấy có hàm này. Nếu 2019 thì hình như có hàm Sequence rồi.
Function TachSo(iStr As String, iD As Byte) As Double
Dim S, Tmp$, j&
S = Split(iStr, "X")
If UBound(S) < iD Then ReDim Preserve S(0 To iD - 1)
Tmp = S(iD - 1)
For j = 1 To Len(S(iD - 1))
If IsNumeric(Mid(Tmp, j)) = True Then
TachSo = Val(Mid(Tmp, j)): Exit Function
End If
Next j
End Function
