Tạo mã nhân sự dạng NTH99 cho "Ngô Thị Thanh Hoa".

[SA_DQ]

Ta có danh sách nhân sự (Nhân viên cơ quan hay học sinh,. . . ) cần tạo mã. Danh sách được lập tại 2 cột [B:C]
như dưới đây

  Họ Đêm                Tên     Mã sẽ tạo
Nguyễn Thu              Ngâm    NTN00
Ngô Văn Thảnh           Nhu     NTN01
Công Tằng Tôn Nữ Minh   Nguyệt  CMN00
Cỗ Văn                  Ẩn      CVA00
Nguyễn                  Đức     NJF00
Dương Quốc              Đông    DQF00
Nhâm Thị                Nhàn    NTN02
Nhã Thị Thu             Na      NTN03

Mã loại này có tính ưu việt của nó so với các loại mã khác ở tính trực quan & tương tác rất cao; Gán kết giữa người quản lí & chịu quản lí tốt hơn.
Nó cho ta dễ dàng lập danh sách tìm kiếm theo họ hay theo tên của hàng loạt nhân sự (NS)

Để tạo mã này, macro cần thực hiện các bước:
Lấy lần lượt 3 chữ cái đầu của:
1: Chữ cái đầu của họ
2. Chữ cái đầu của từ cuối của trong [Họ Đệm]
3. Chữ cái đầu của tên NS
(*) Trường hợp NS chỉ có họ & tên như Hà Tăng, ta thêm vô 'J' chính giữa (Để đảm bảo độ dài của mã luôn bằng nhau, giãm trùng lắp mã,. . .)
Cũng để giảm trùng lắp ta thay 'Đ' bỡi 'F' (vì nó gần 'D' trên bàn fím & hiếm khi thấy nó trong tên tiếng Việt)

Bước tiếp sau sẽ là đổi/bỏ các đấu tiếng Việt nếu có
Để vậy ta xài hàm người dùng như vầy:

Function LoaiDauTV(ByVal Txt As String) As String
 Dim Charcode(), ResTxt(), I As Long, Tmp As String
 
 Tmp = UCase$(Txt)
 Charcode = Array(7862, 7860, 7858, 7856, 7854, 7852, 7850, 7848, 7846, 7844, 7842, 7840, 258, 195, 194, 193, 192 _
  , 7878, 7876, 7874, 7872, 7870, 7868, 7866, 7864, 202, 201, 200, 7882, 7880, 296, 205, 204, 272 _
  , 7990, 7906, 7904, 7902, 7898, 7896, 7894, 7892, 7890, 7888, 7886, 7884, 416, 213, 212, 211, 210 _
  , 7920, 7918, 7916, 7914, 7912, 7910, 431, 360, 218, 217, 7928, 7926, 7924, 7922, 221)
  
 ResTxt = Array("A", "A", "A", "A", "A", "A", "A", "A", "A", "A", "A", "A", "A", "A", "A", "A", "A" _
  , "E", "E", "E", "E", "E", "E", "E", "E", "E", "E", "E", "I", "I", "I", "I", "I", "F" _
  , "O", "O", "O", "O", "O", "O", "O", "O", "O", "O", "O", "O", "O", "O", "O", "O", "O", "O" _
  , "U", "U", "U", "U", "U", "U", "U", "U", "U", "U", "U", "Y", "Y", "Y", "Y", "Y")
 For I = 0 To UBound(Charcode)
  Tmp = Replace(Tmp, ChrW(Charcode(I)), ResTxt(I))
 Next
 BoDauTV = Tmp
End Function

Bước kế tiếp là ta cần fân biệt giữa các mã có fần 3 kí tự đầu giống nhau bỡi các kí số (hay kí tự, nếu nhiều)
Như vậy ta có mã NS luôn gồm 5 kí tự; trong đó 3 chữ cái đầu (mình gọi là fần đặc tính) luôn là kí tự; Còn lại ( tạm gọi là fần định trị) thường là 2 kí số. (Với danh sách HS của 1 trường gồm >1.500 HS, fần định trị chỉ cỡ 15-17 là cùng)
Chuyện này sau bài tiếp các bạn có thể tự chiêm nghiệm.

 

[SA_DQ]

Macro chính:

Dim sTxt$, aSplit, Arr
Dim Rws As Long

Sub TaoMa5()
 Dim Rng As Range, Arr()
 Dim J&, Rws&, ViTri As Byte
 Dim Ho$, Ten$, HoDem$
 On Error Resume Next
 
 Sheets("Ch08").Select
 Rws = [b2].CurrentRegion.Rows.Count
 Arr() = [b2].Resize(Rws, 2).Value
 ReDim dArr(1 To Rws, 1 To 1)
 [d1].Value = "Mã NV"
 For J = 1 To UBound(Arr())
  Ho = Left(Trim$(Arr(J, 1)), 1)
  If Ho = "" Then Exit For
  dArr(J, 1) = LoaiDauTV(Ho)
  HoDem = LTrim$(Arr(J, 1))
  If InStr(HoDem, " ") < 1 Then
  dArr(J, 1) = dArr(J, 1) & "J"
  Else
  dArr(J, 1) = dArr(J, 1) & LoaiDauTV(Left(TachTen(HoDem), 1))
  End If
  Ten = Left(LTrim$(Arr(J, 2)), 1)
  dArr(J, 1) = dArr(J, 1) & LoaiDauTV(Ten) & "00"
 Next J
 [d2].Resize(J).Value = dArr()
 gpeTM
End Sub

Sub gpeTM()
'Macro Tang Fàn Dinh Tri Cua Các Ma Trùng:'
 Dim Cls As Range, sMa As String, Num As Integer
 Const Ba0 As String = "00"
 Columns("B:D").Select
 'Sáp Xép Theo Cot [D]'
 Selection.Sort Key1:=Range("D2"), Order1:=xlAscending, Key2:=Range("c2"), Order2:=xlAscending _
  , Header:=xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
 For Each Cls In Range([d3], [d3].End(xlDown))
  If Left(Cls.Value, 3) <> Left(Cls.Offset(-1).Value, 3) Then
  sMa = Left(Cls.Value, 3)
  Else
  Num = CInt(Right(Cls.Offset(-1).Value, 2)) + 1
  Cls.Value = sMa & Right(Ba0 & CStr(Num), 2)
  End If
 Next Cls
End Sub

Hàm để lấy từ cuối của [Họ & Đêm]
Function TachTen(HoTen As String) As String
 Dim ViTri As Byte
 
 HoTen = Trim(HoTen)
 If HoTen = "" Then
  TachTen = ""
 Else
  ViTri = InStrRev(HoTen, " ", Len(HoTen))
  If ViTri = 0 Then
  TachTen = HoTen
  Else
  TachTen = Mid(HoTen, ViTri + 1)
  End If
 End If
End Function

 

[SA_DQ]

SỬ DUNG MÃ NS ĐỂ TÌM KIẾM, SỬA ĐỔI HAY BỔ SUNG & NHẬP MỚI DỮ LIỆU.​

Trong 1 danh sách nhân sự đủ nhiều, phần đặc tính của mã NS (nêu ở bài trước) sẽ có trùng nhau.
& chuyện thể hiện hay tìm kiếm danh sách trùng này là dễ dàng.
Trong file kèm theo là việc ứng dụng công tác tìm kiếm danh sách trùng đó trên 1 Form; Thể hiện kết quả lên 1 ListBox
Tiếp theo ta có thể sửa hay cập nhật 1 nội dung nào đó. (Ở trong file là cập nhật hay bổ sung mã đơn vị/bộ fận cho 1 đương sự cụ thể.)
Ngoài ra chúng ta hoàn toàn có quyền nhập mới dữ liệu cho 1 nhân viên mới nhập/nhận vô cơ quan

Xin các bạn xem & trãi nghiệm theo file đính kèm & chúc thành công!

 

[SA_DQ]

Ở bài đăng 1 ta thấy danh sách nhân sự được tách làm 2 thành tố; 1 là họ đệm & 2 là tên của nhân sự;
Trong thực tế, nhiều lúc ta gặp danh sách dữ liệu [Họ tên] chỉ trong 1 cột, như:

Dương Quốc Huy
Bùi Xuân Thắm
Đỗ Lê  Ngọc Minh
Nguyễn Việt Hồng
Lê Thị Thơm

Điều đó buộc ta fải thay đổi nội dung macro; Nội dung thay đổi đó thể hiện trong macro sau:

Sub Ma_HoTen()
 Dim J As Long
 Dim Tmp As String, Ma As String
 
 Sheets("Ch08").Select
 Rws = [ab2].CurrentRegion.Rows.Count
 For J = 2 To Rws
  If Cells(J, "AB").Value = "" Then
  Exit For
  End If
  Ma = BoDauTV(Left(Cells(J, "AB").Value, 1))
  sTxt = TachTen(Cells(J, "AB").Value)  'Tên'
  Tmp = Replace(Cells(J, "AB").Value, " " & sTxt, "")
  If InStr(Tmp, " ") < 1 Then
  Ma = Ma & "J"
  Else
  Tmp = Left(TachTen(Tmp), 1)
  Ma = Ma & BoDauTV(Tmp)
  End If
  sTxt = BoDauTV(Left(sTxt, 1))
  Cells(J, "AC").Value = Ma & sTxt & "00"
 Next J
 Cells(1, "AC").Value = "Mã"
 gpeSX Columns("AB:AC")
End Sub

Sub gpeSX(Rng As Range)  'Macro Tang Fàn Dinh Tri Cua Các Ma Trùng:'
 Dim Cls As Range, Rg0 As Range:  Dim sMa As String, Num As Integer
 Rng.Select
  If Rng.Columns.Count = 2 Then
  Set Rg0 = [ac2]
  ElseIf Rng.Columns.Count = 3 Then
  Set Rg0 = [D2]
  End If
 Selection.Sort Key1:=Rg0, Order1:=xlAscending, Key2:=Rg0.Offset(, -1), Order2:=xlAscending _
  , Header:=xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
  Set Rg0 = Rg0.Offset(1)
 For Each Cls In Range(Rg0, Rg0.End(xlDown))
  If Left(Cls.Value, 3) <> Left(Cls.Offset(-1).Value, 3) Then
  sMa = Left(Cls.Value, 3)
  Else
  Num = CInt(Right(Cls.Offset(-1).Value, 2)) + 1
  Cls.Value = sMa & Right("0" & CStr(Num), 2)
  End If
 Next Cls
End Sub

& hàm để loại bỏi dấu tiếng Việt:

Function BoDauTV(ByVal Txt As String) As String
 Dim Charcode(), ResTxt(), I As Long, Tmp As String
 
 Tmp = UCase$(Txt)
 Charcode = Array(7862, 7860, 7858, 7856, 7854, 7852, 7850, 7848, 7846, 7844, 7842, 7840, 258, 195, 194, 193, 192 _
  , 7878, 7876, 7874, 7872, 7870, 7868, 7866, 7864, 202, 201, 200, 7882, 7880, 296, 205, 204, 272 _
  , 7990, 7906, 7904, 7902, 7898, 7896, 7894, 7892, 7890, 7888, 7886, 7884, 416, 213, 212, 211, 210 _
  , 7920, 7918, 7916, 7914, 7912, 7910, 431, 360, 218, 217, 7928, 7926, 7924, 7922, 221)
 
 ResTxt = Array("A", "A", "A", "A", "A", "A", "A", "A", "A", "A", "A", "A", "A", "A", "A", "A", "A" _
  , "E", "E", "E", "E", "E", "E", "E", "E", "E", "E", "E", "I", "I", "I", "I", "I", "F" _
  , "O", "O", "O", "O", "O", "O", "O", "O", "O", "O", "O", "O", "O", "O", "O", "O", "O", "O" _
  , "U", "U", "U", "U", "U", "U", "U", "U", "U", "U", "U", "Y", "Y", "Y", "Y", "Y")
 For I = 0 To UBound(Charcode)
  Tmp = Replace(Tmp, ChrW(Charcode(I)), ResTxt(I))
 Next
 BoDauTV = Tmp
End Function

 

[SA_DQ]

MÃ HÓA SỐ LIỆU CHỈ NGÀY THÁNG NĂM THÀNH CHUỖI CÓ ĐỘ DÀI LUÔN 3​

Vì dụ ta có ngày #07/11/2017#; Ta cần viết hàm chuyển đổi ngày này thành chuỗi "GA7" biểu diễn tương ứng với ngày cụ thể đề ra

Nội dung hàm tự tạo này gồm các câu lệnh như dưới đây:

Function MaNTN(Optional Dat As Date)
 Const Alf As String = "0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ"
 If Dat = 0 Then Date = Date
 MaNTN = Mid(Alf, (Year(Dat) - 2000), 1)
 MaNTN = MaNTN & Mid(Alf, 1 + Month(Dat), 1) & Mid(Alf, 1 + Day(Dat), 1)
End Function

 

[SA_DQ]

TẠO MÃ CHO NHÂN VIÊN MỚI & NHẬP LIỆU.​

Xin mời các bạn thử nghiệm với file:

 

[QDuc]

& đây là cách thức tạo mã dạng "ABC**"
Xin mời các bạn tham khảo trong file
(Chủ yếu dùng công thức)

 

[SA_DQ]

Nhập hồ sơ cho người mới chuyển vào cơ quan
Mã NV của người mới vô CQ được tạo ra trên cơ sở những mã nhân viên cùng "họ mã" trong CQ