Hàm vả thủ tục tách họ tên doc

Hàm vả thủ tục tách họ tên Họ tên thường nhập chung 1 cột cho nhanh.. Sau đó ta có thể tách riêng tên ra 1 cột.. Nhưng có lúc chúng ra cần tách ra 2 cột: cột họ, cột tên... chèn thêm cột

Hàm vả thủ tục tách họ tên

Họ tên thường nhập chung 1 cột cho nhanh Sau đó ta có thể tách riêng tên ra 1 cột Nhưng có lúc chúng ra cần tách ra 2 cột: cột họ, cột tên Đây là 2 làm làm công việc đó:

'======================

Function TachHo(hoten As String) As String

hoten = Trim(hoten)

If hoten = "" Then

TachHo = ""

Else

vt = InStrRev(hoten, " ", Len(hoten))

If vt = 0 Then

TachHo = ""

Else

TachHo = Trim(Mid(hoten, 1, vt))

End If

End If

End Function

'====================

Function TachTen(hoten As String) As String

hoten = Trim(hoten)

If hoten = "" Then

TachTen = ""

Else

vt = InStrRev(hoten, " ", Len(hoten))

If vt = 0 Then

TachTen = hoten

Else

TachTen = Mid(hoten, vt + 1)

End If

End If

End Function

'===================

Bạn sử dụng hàm này bình thường như các hàm khác của Excel, nhưng nếu bạn cần tách họ tên thành 2 cột riêng biệt thì bạn phải thực hiện một loạt các thao tác sau:

1 tách họ, tách tên trên 2 cột phụ

2 chèn thêm cột bên trái cột họ tên

3 Copy 2 cột họ tên mới tách và dán bằng Paste Special - Value trở về nơi cũ

Để làm nhanh các công việc đó, bạn có thể sử dụng thủ tuc TachHoTen

Sử dụng thủ tục này như sau:

1 Chọn tất cả các ô chứa họ tên, kể cả ô chứa tiêu đề trên đầu

2 Chạy Sub TachHoTen

VBA sẽ làm thay cho bạn các việc còn lại Lưu ý bạn là số cột trong vùng chọn phải là 1, nếu lớn hơn 1 VBA không thực hiện

'====================

Sub TachHoTen()

rd = Selection.Row

sr = Selection.Rows.Count

rc = rd + sr - 1

c = Selection.Column

sc = Selection.Columns.Count

If sc > 1 Then

MsgBox "Ban chon " & sc & " cot Ban phai chon lai 1 cot", vbOKOnly, "Thong bao"

Exit Sub

End If

Range(Cells(rd, c), Cells(rc, c)).Insert Shift:=xlToRight

Range(Cells(rd, c), Cells(rc, c)).Insert Shift:=xlToRight

For r = rd To rc

Cells(r, c) = TachHo(Cells(r, c + 2))

Cells(r, c + 1) = TachTen(Cells(r, c + 2))

Next

Range(Cells(rd, c + 2), Cells(rc, c + 2)).Delete Shift:=xlToLeft

End Sub

'==============