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

  • Thread starter SA_DQ
  • Ngày gửi
S

SA_DQ

Thành viên Cố vấn - Webketoan Mentors
29/6/05
568
99
28
66
HCM city
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
Mã:
  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:
PHP:
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.
 
Sửa lần cuối:
Khóa học Quản trị dòng tiền
S

SA_DQ

Thành viên Cố vấn - Webketoan Mentors
29/6/05
568
99
28
66
HCM city
Macro chính:
PHP:
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
Mã:
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
PHP:
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
 
Sửa lần cuối:
  • Like
Reactions: quick87
S

SA_DQ

Thành viên Cố vấn - Webketoan Mentors
29/6/05
568
99
28
66
HCM city
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!
 

Đính kèm

  • GPE.rar
    28.9 KB · Lượt xem: 102
  • Like
Reactions: quick87
S

SA_DQ

Thành viên Cố vấn - Webketoan Mentors
29/6/05
568
99
28
66
HCM city
Ở 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ư:
PHP:
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:
PHP:
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
Mã:
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:
PHP:
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
 
Sửa lần cuối:
S

SA_DQ

Thành viên Cố vấn - Webketoan Mentors
29/6/05
568
99
28
66
HCM city
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:
Mã:
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
 
QDuc

QDuc

Cao cấp
3/6/06
254
18
18
Biển khơi
& đâ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)
 

Đính kèm

  • Mã.rar
    15.1 KB · Lượt xem: 34
S

SA_DQ

Thành viên Cố vấn - Webketoan Mentors
29/6/05
568
99
28
66
HCM city
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
 

Đính kèm

  • Form.rar
    41.5 KB · Lượt xem: 28
  • Like
Reactions: Thanh Nam

Xem nhiều

Webketoan Zalo OA