Home » VBA Excel » VBA Excel tách họ tên

VBA Excel tách họ tên

viết bởi Lê Quốc Thái
  1. Loạt các bài viết có liên quan chuyên đề VBA:
  2. VBA Excel Hộp thoại thông báo
  3. VBA Excel Biến trong VBA Excel
  4. VBA Excel sử dụng Scripting Dictionary
  5. VBA Excel Biến trong VBA Excel
  6. VBA Excel Workbook, worksheet
  7. VBA Excel Range, Cells
  8. VBA Excel Hàm trong Excel VBA
  9. VBA Excel Events, Application Object
  10. VBA Excel Function and Sub Excel VBA
  11. VBA Excel Array Mảng trong Excel VBA
  12. VBA Excel FileSystemObject trong Excel VBA
  13. VBA Excel Collection trong Excel VBA
  14. VBA Excel Hashtable trong Excel VBA
  15. VBA Excel Stack trong Excel VBA
  16. VBA Excel Queue trong Excel VBA
  17. VBA Excel SortedList Excel VBA
  18. VBA Excel ArrayList Excel VBA
  19. VBA Excel Ví dụ về Scripting Dictionary
  20. Sách VBA Excel 2016 power programming with vba (pdf)

Khi nhập liệu vào bảng tính Excel, thông thường ta nhập cả họ và tên vào cùng một ô. Tuy nhiên, có khi sau đó ta cần phải tách riêng tên ra khỏi họ và tên đệm, nếu làm thủ công bằng thao tác sao chép rồi dán qua ô khác thì sẽ rất bất tiện. Ngoài ra có những lúc bạn phải xắp xếp lại theo thứ tự A,B,C,…
Nếu sử dụng hàm Right kết hợp với một vài hàm khác thì cũng có thể cho ra kết quả như bạn muốn, nhưng trong một số trường hợp sẽ cho kết quả không chính xác. Có một phương pháp tối ưu hơn sẽ giúp bạn hoàn thành tốt công việc này, cách thực hiện cũng khá đơn giản như sau:
– Trên bảng tính chứa cột họ tên cần tách, bạn chọn menu Tools > Macro > Visual Basic Editor, lập tức xuất hiện chương trình Microsoft Visual Basic.
– Tiếp theo, bạn nhấn menu Insert và chọn Module sẽ xuất hiện một cửa sổ soạn thảo.

Bạn nhập đoạn mã lệnh sau vào cửa sổ soạn thảo:

Private Function Tachten(ten As String, lg As Integer)
Dim j As Integer
     Name = Trim(ten)
  For j = Len(Name) To 1 Step -1
    If Mid(Name, j, 1) = " " Then
       If lg = "1" Then
          Tachten = Right(Name, Len(Name) - j)
       Else
          Tachten = Left(Name, j)
       End If
  Exit For
    End If
  Next
End Function

– Bạn nhấn Ctrl+S để lưu lại và quay trở về bảng tính Excel.
– Bây giờ để tiến hành tách riêng họ và tên đệm vào một ô mới, bạn đặt con trỏ tại ô mới chứa họ và tên đệm rồi nhập vào công thức =TachTen(B3,0) và nhấn Enter sẽ thấy ngay kết quả.
– Để tách riêng tên vào một ô mới, bạn đặt con trỏ tại ô sẽ chứa tên cần tách và nhập vào công thức =TachTen(B3,1) rồi nhấn Enter là xong.
Ghi chú: B3 chính là địa chỉ của ô ban đầu chứa cả họ, tên đệm và 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
'==============

Bài viết liên quan

Viết ý kiến của bạn