Code tạo mã nhân viên theo họ và tên

Liên hệ QC
Thanhhoai00

Thanhhoai00

Thành viên chính thức
Tham gia
19/7/20
Bài viết
58
Được thích
13
Mình có đoạn code sau
Khi chạy xong đã tạo được mã nhân viên bằng cách lấy chữ cái đầu dòng của họ + tên lót + tên
Nhưng khi chạy ra mã nhân viên bị trùng nhau, các bạn có cách nào code để tạo ra mã dạng như
Nvt001, nvt002,nvt003
...............................
Trần văn tý. > tvt001
Trần văn tèo. > Tvt002
................................
Phạm thị phượng > Ptp001
Phạm thị phương >Ptp002
Phạm thanh phong >Ptp003
...............
Giúp mình nhé ! Cảm ơn các bạn !!!
Mã: 
Function Firstchar(Str As String) As String
Dim i As Byte
Str = Trim(Str): Firstchar = Left(Str, 1)
For i = 1 To Len(Str)
    If Mid(Str, i, 1) = " " Then Firstchar = Firstchar + Mid(Str, i + 1, 1)
Next
End Function
Sub an()
Dim i As Integer
For i = 2 To 100 ' n là dòng cu?i d? li?u
Range("B" & i).Value = Firstchar(Range("C" & i).Value)
Next i
End Sub
 

File đính kèm

  • maNv2.xlsx
    8.7 KB · Đọc: 14
  • Screenshot_20200809-071734_Excel.jpg
    Screenshot_20200809-071734_Excel.jpg
    62.4 KB · Đọc: 16
Lần chỉnh sửa cuối:
Rất hoan hô bạn với bộ mã đề xuất

Nhưng khi dùng bạn sẽ vấp những khiếm khuyết mà ngay lúc này nên nghĩ cách khắc phục

Trước tiên mình đề xuất bộ mã mình hay xài như sau:

STTMã của bạnHọ & TênMã đề nghị
1NVH000Nguyễn Việt HồngNVH00
2NVH001Ngô Viết HàNVH01
3NTVH000Ngô Thị Việt HoàngNVH02
4CtTNNM000Công tằng Tôn Nữ Nguyệt MinhCNM00
5NH000Ngô HảiNJH00
6ÂDL000Âu Dương LânADL00
7TÁN000Trần Ánh NguyệtTAN00
8DÂĐ000Dương Ân ĐịnhDAF00
9ĐDĐ000Đỗ Dương ĐứcFDF00

1./ Mã nên là chữ in hoàn toàn & quan trong là không chứa tiếng Việt có dấu
Chữ Đ không nên chuyễn thành D, mà nên xài kí tự 'F' (chẳng qua F gần D trên bàn phím & hầu như không có trong tên người Việt;)

2./ Mã nên có độ dài như nhau

3./ Phần định trị của mã chỉ nên hai kí số hay 2 kí tự:
a./ Mình đã thữ xài bộ mã mình đề xuất cho 1 trường 4 500 HS thì phần định trị chỉ tới con số 17; Còn lâu lắm mói tới 99. (Mà nói rọng ra toàn quốc thì từ 00 đến ZZ sẽ là 36*36 mã đó bạn)

Thân ái
 
SA_DQ đã viết:
Rất hoan hô bạn với bộ mã đề xuất

Nhưng khi dùng bạn sẽ vấp những khiếm khuyết mà ngay lúc này nên nghĩ cách khắc phục

Trước tiên mình đề xuất bộ mã mình hay xài như sau:

STTMã của bạnHọ & TênMã đề nghị
1NVH000Nguyễn Việt HồngNVH00
2NVH001Ngô Viết HàNVH01
3NTVH000Ngô Thị Việt HoàngNVH02
4CtTNNM000Công tằng Tôn Nữ Nguyệt MinhCNM00
5NH000Ngô HảiNJH00
6ÂDL000Âu Dương LânADL00
7TÁN000Trần Ánh NguyệtTAN00
8DÂĐ000Dương Ân ĐịnhDAF00
9ĐDĐ000Đỗ Dương ĐứcFDF00

1./ Mã nên là chữ in hoàn toàn & quan trong là không chứa tiếng Việt có dấu
Chữ Đ không nên chuyễn thành D, mà nên xài kí tự 'F' (chẳng qua F gần D trên bàn phím & hầu như không có trong tên người Việt;)

2./ Mã nên có độ dài như nhau

3./ Phần định trị của mã chỉ nên hai kí số hay 2 kí tự:
a./ Mình đã thữ xài bộ mã mình đề xuất cho 1 trường 4 500 HS thì phần định trị chỉ tới con số 17; Còn lâu lắm mói tới 99. (Mà nói rọng ra toàn quốc thì từ 00 đến ZZ sẽ là 36*36 mã đó bạn)

Thân ái
Nhấp chuột vào đây để mở rộng...
Thưa thầy . Vậy với các trường hợp :
Âu Hoàng Phúc; Ưng Thị Doan ..... thì ta nên xử lý thế nào cho tiện và không trùng - Cảm ơn thầy
 
Thanhhoai00 đã viết:
Mình có đoạn code sau
Khi chạy xong đã tạo được mã nhân viên bằng cách lấy chữ cái đầu dòng của họ + tên lót + tên
Nhưng khi chạy ra mã nhân viên bị trùng nhau, các bạn có cách nào code để tạo ra mã dạng như
Nvt001, nvt002,nvt003
...............................
Trần văn tý. > tvt001
Trần văn tèo. > Tvt002
................................
Phạm thị phượng > Ptp001
Phạm thị phương >Ptp002
Phạm thanh phong >Ptp003
...............
Giúp mình nhé ! Cảm ơn các bạn !!!
Mã: 
Function Firstchar(Str As String) As String
Dim i As Byte
Str = Trim(Str): Firstchar = Left(Str, 1)
For i = 1 To Len(Str)
    If Mid(Str, i, 1) = " " Then Firstchar = Firstchar + Mid(Str, i + 1, 1)
Next
End Function
Sub an()
Dim i As Integer
For i = 2 To 100 ' n là dòng cu?i d? li?u
Range("B" & i).Value = Firstchar(Range("C" & i).Value)
Next i
End Sub
Nhấp chuột vào đây để mở rộng...
bạn đưa file lên thì mọi người mới giúp được chứ????
 
Thanhhoai00 đã viết:
Mình có đoạn code sau
Khi chạy xong đã tạo được mã nhân viên bằng cách lấy chữ cái đầu dòng của họ + tên lót + tên
Nhưng khi chạy ra mã nhân viên bị trùng nhau, các bạn có cách nào code để tạo ra mã dạng như
Nvt001, nvt002,nvt003
...............................
Trần văn tý. > tvt001
Trần văn tèo. > Tvt002
................................
Phạm thị phượng > Ptp001
Phạm thị phương >Ptp002
Phạm thanh phong >Ptp003
...............
Giúp mình nhé ! Cảm ơn các bạn !!!
Nhấp chuột vào đây để mở rộng...
Nếu đã là NHÂN VIÊN sao bạn không dùng ID của họ làm mã? Hay công ty bạn chưa có mã nhân viên?
Cũng có thể dùng số CMND là mã được mà?
Việc tạo mã bằng cách viết tắt họ tên là thứ rất kỳ cục và không khoa học tí nào
 
. . . . . (2)Cũng có thể dùng số CMND là mã được mà? (1) Việc tạo mã bằng cách viết tắt họ tên là thứ rất kỳ cục và không khoa học tí nào
Nhấp chuột vào đây để mở rộng...
(1) Khoa học hay không còn cần kiểm chứng, nhưng tính tương tác cao giữa người sử dụng mã & quản lý mã sẽ cao hơn 12 các con số vô tri giác;

(2) Mã nên có độ dài như nhau; Vậy tất phải lấy hay cập nhật 12 kí số của CCCD. Hình như việc này phải đến hết năm này phải xong; Đó là í chí & nguyện vọng thôi, để xem!
 
Bạn tham khảo sử dụng hàm dưới đây:

Sử dụng cho ô:
=NameToCode(C2)

Sử dụng cho cả cột:
=S_NameToCode(C2:C10000,False)

Nếu viết Hoa thì: =S_NameToCode(C2:C10000,TRUE)

Nếu tên phân cách là dấu gạch (-) thì: =S_NameToCode(C2:C10000,False,"-")

Nếu trùng tên bắt đầu từ số 0 hoặc ... thì: =S_NameToCode(C2:C10000,False,"-",1)

Nếu định dạng nhiều số 0 thì: =S_NameToCode(C2:C10000,False,"-",1, "0000")

---------------------------------
JavaScript: 
Option Explicit

#If VBA7 Then
  Private Declare PtrSafe Function SetTimer Lib "user32" (ByVal HWnd As LongPtr, ByVal nIDEvent As LongPtr, ByVal uElapse As LongPtr, ByVal lpTimerFunc As LongPtr) As Long
  Private Declare PtrSafe Function KillTimer Lib "user32" (ByVal HWnd As LongPtr, ByVal nIDEvent As LongPtr) As Long
#Else
  Private Declare Function SetTimer Lib "user32" (ByVal HWnd As Long, ByVal nIDEvent As Long, ByVal uElapse As Long, ByVal lpTimerFunc As Long) As Long
  Private Declare Function KillTimer Lib "user32" (ByVal HWnd As Long, ByVal nIDEvent As Long) As Long
#End If

'///////////////////////////////////////////////////////
#If Win64 Then
  Private gTimerID As LongPtr, gTimerID2 As LongPtr
#Else
  Private gTimerID As Long, gTimerID2 As Long
#End If
'///////////////////////////////////////////////////////
Private NameToCode_OArgs(), NameToCode_OIndex As Integer

Function S_NameToCode(ByVal values As Range, _
             Optional ByVal upper As Boolean, _
             Optional ByVal Delimiter As String = " ", _
             Optional ByVal CodeNumberStart As Long = 0, _
             Optional ByVal Format As String = "000") As Variant
  On Error Resume Next
  KillTimer 0&, gTimerID: gTimerID = 0
  '-----------------------------------------------
  Dim d As Object
  S_NameToCode = NameToCode(CStr(values(1, 1).value), upper, Delimiter, CodeNumberStart, Format, d)
  '-----------------------------------------------
  If values.Cells.Count > 1 Then
    Dim UB As Integer, K As Integer
    '-----------------------------------------------
    UB = UBound(NameToCode_OArgs, 2): K = UB
    K = K + 1
    ReDim Preserve NameToCode_OArgs(1 To K)
    NameToCode_OArgs(K) = Array(values, upper, Delimiter, CodeNumberStart, Format, d, Application.Caller)
    gTimerID = SetTimer(0&, 0&, 1, AddressOf S_NameToCode_callback)
  End If
End Function
'///////////////////////////////////////////////////////
Private Sub S_NameToCode_callback()
  On Error Resume Next
  Call KillTimer(0&, gTimerID): gTimerID = 0
  Call KillTimer(0&, gTimerID2): gTimerID2 = 0
  On Error GoTo 0
  '----------------------------------
  Dim UA As Integer
  UA = UBound(NameToCode_OArgs)
  If UA > 0 Then
    NameToCode_OIndex = NameToCode_OIndex + 1
    '-------------------------------------------
    Dim Args, R As Long, C As Integer, total(), total2(), UB As Long, UB2 As Integer
    Dim d As Object, upper As Boolean, Delimiter As String, Format As String, CodeNumberStart As Long
    Dim Rng As Range
    Args = NameToCode_OArgs(NameToCode_OIndex)
    Set Rng = Args(0)
    UB = Rng(Rng.Rows.Count + 2, 1).End(3).Row - Rng.Row + 1
    If UB > 0 Then
      Args(0) = Rng(1, 1).Resize(UB, Rng.Columns.Count).value
      Set d = Args(5): upper = Args(1): Delimiter = Args(2): Format = Args(4)
      CodeNumberStart = Args(3)
      UB2 = UBound(Args(0), 2)
      ReDim total(2 To Rng.Rows.Count, 1 To UB2)
      For R = 2 To UB
        For C = 1 To UB2
          If Args(0)(R, C) <> "" Then
            total(R, C) = NameToCode(CStr(Args(0)(R, C)), upper, Delimiter, CodeNumberStart, Format, d)
          End If
        Next
      Next
      Args(6)(2, 1).Resize(UBound(total) - 1, UB2).value = total
      If UB2 > 1 Then
        ReDim total2(1 To 1, 2 To UB2)
        For C = 2 To UB2
          If Args(0)(1, C) <> "" Then
            total2(1, C) = NameToCode(CStr(Args(0)(1, C)), upper, Delimiter, CodeNumberStart, Format, d)
          End If
        Next
        Args(6)(1, 2).Resize(, UB2 - 1).value = total2
      End If
    End If
    '-------------------------------------------
    If NameToCode_OIndex >= UA Then
      Erase NameToCode_OArgs: NameToCode_OIndex = 0
    Else
      gTimerID = SetTimer(0&, 0&, 1, AddressOf S_NameToCode_callback2)
    End If
  End If
End Sub
Private Sub S_NameToCode_callback2()
  S_NameToCode_callback
End Sub
Function NameToCode(Text As String, _
    Optional ByVal upper As Boolean, _
    Optional ByVal Delimiter As String = " ", _
    Optional ByVal CodeNumberStart As Long = 0, _
    Optional ByVal strFormat As String = "000", _
    Optional ByRef DList As Object) As Variant
  If Text = "" Then NameToCode = "": Exit Function
  Dim a As String, e As String, i As String, o As String, u As String, y As String, d As String
  a = "[aA" & ChrW(224) & ChrW(225) & ChrW(226) & ChrW(227) & ChrW(259) & ChrW(7841) & ChrW(7843) & ChrW(7845) & ChrW(7847) & ChrW(7849) & ChrW(7851) & ChrW(7853) & ChrW(7855) & ChrW(7857) & ChrW(7859) & ChrW(7861) & ChrW(7863) & ChrW(65) & ChrW(192) & ChrW(193) & ChrW(194) & ChrW(195) & ChrW(258) & ChrW(7840) & ChrW(7842) & ChrW(7844) & ChrW(7846) & ChrW(7848) & ChrW(7850) & ChrW(7852) & ChrW(7854) & ChrW(7856) & ChrW(7858) & ChrW(7860) & ChrW(7862) & "]"
  e = "[eE" & ChrW(232) & ChrW(233) & ChrW(234) & ChrW(7865) & ChrW(7867) & ChrW(7869) & ChrW(7871) & ChrW(7873) & ChrW(7875) & ChrW(7877) & ChrW(7879) & ChrW(200) & ChrW(201) & ChrW(202) & ChrW(7864) & ChrW(7866) & ChrW(7868) & ChrW(7870) & ChrW(7872) & ChrW(7874) & ChrW(7876) & ChrW(7878) & "]"
  i = "[iI" & ChrW(236) & ChrW(237) & ChrW(297) & ChrW(7881) & ChrW(7883) & ChrW(204) & ChrW(205) & ChrW(296) & ChrW(7880) & ChrW(7882) & "]"
  o = "[oO" & ChrW(242) & ChrW(243) & ChrW(244) & ChrW(245) & ChrW(417) & ChrW(7885) & ChrW(7887) & ChrW(7889) & ChrW(7891) & ChrW(7893) & ChrW(7895) & ChrW(7897) & ChrW(7899) & ChrW(7901) & ChrW(7903) & ChrW(7905) & ChrW(7907) & ChrW(210) & ChrW(211) & ChrW(212) & ChrW(213) & ChrW(416) & ChrW(7884) & ChrW(7886) & ChrW(7888) & ChrW(7890) & ChrW(7892) & ChrW(7894) & ChrW(7896) & ChrW(7898) & ChrW(7900) & ChrW(7902) & ChrW(7904) & ChrW(7906) & "]"
  u = "[uU" & ChrW(249) & ChrW(250) & ChrW(361) & ChrW(432) & ChrW(7909) & ChrW(7911) & ChrW(7913) & ChrW(7915) & ChrW(7917) & ChrW(7919) & ChrW(7921) & ChrW(217) & ChrW(218) & ChrW(360) & ChrW(431) & ChrW(7908) & ChrW(7910) & ChrW(7912) & ChrW(7914) & ChrW(7916) & ChrW(7918) & ChrW(7920) & "]"
  y = "[yY" & ChrW(253) & ChrW(7923) & ChrW(7925) & ChrW(7927) & ChrW(7929) & ChrW(221) & ChrW(7922) & ChrW(7924) & ChrW(7926) & ChrW(7928) & "]"
  d = "[dD" & ChrW(273) & ChrW(272) & "]"
  Dim S1 As String, S2 As String, s As String, SP() As String
  Dim L1 As Integer, L2 As Integer
  SP = Split(Text, Delimiter): L2 = UBound(SP)
  For L1 = 0 To L2
    S1 = LCase(Left(SP(L1), 1))
    Select Case True
    Case S1 Like a: S1 = "a"
    Case S1 Like e: S1 = "e"
    Case S1 Like i: S1 = "i"
    Case S1 Like o: S1 = "o"
    Case S1 Like u: S1 = "u"
    Case S1 Like y: S1 = "y"
    Case S1 Like d: S1 = "d"
    End Select
    SP(L1) = S1
  Next
  S2 = Join(SP, ""):
  If DList Is Nothing Then
    Set DList = VBA.CreateObject("Scripting.Dictionary")
    DList.compareMode = 1
  Else
    While DList.exists(S2 & Format(CodeNumberStart, strFormat))
      CodeNumberStart = CodeNumberStart + 1
    Wend
  End If
  NameToCode = S2 & Format(CodeNumberStart, "000")
  If upper Then NameToCode = UCase(NameToCode)
  DList(NameToCode) = CodeNumberStart
End Function
 
Lần chỉnh sửa cuối:
Trả lời cho cách bố trí ở bài #1:
Theo quy luật của bạn thì mã gồm 3 ký tự lấy từ tên và 3 chữ số để phân biệt khi bị trùng nhau.
Nói cách khác, mã số của bạn, theo nguyên tắc mã thì nó thuộc loại chuẩn AAA999. Chuẩn là vì nó đúng độ dài, đúng kiểu ký tự.
(người chỉ có tên và họ, không có tên lót hì sao? Có thể phải nới ra thành AA-999?)

Để có thể tính ra con số mã, điều đương nhiên là bạn phải có một bảng chứa mã.
Khi có một nhân viên mới cần thêm thì bạn đã có sẵn hàm lấy 3 ký tự đầu. Có lẽ cần chỉnh hàm này để thêm "-" khi tên chỉ có 2 từ.
Có 3 ký tự rồi thì bạn dò bảng mã để xem có hay chưa. Nếu có rồi thì tăng số lên. Như vậy thôi.

Bạn có hai cách dò. Cách thứ nhất giản dị về code nhưng đòi hỏi bạn phải sắp xếp bảng. Cách thứ hai không cần sắp xếp bảng nhưng đòi bỏi bạn phải viết code ADO.
Ví dụ tên nhân viên cho bạn được mã "tvt" chứa trong biến maKT

1. Appication.Match(maKT & "999", RangeCanDoCoSapXep, 1)
Lấy kết quả. So sánh 3 ký tự đầu:
- nếu không giống thì mã của bạn là mã đầu tiên, cho nó số 001. Lưu ý là nếu error thì cũng là mã đầu tiên. Tuy nhiên, tôi thì sẽ tạo một mã giả "---000" làm dòng đầu tiên, khỏi phải bẫy lỗi.
- nếu giống thì không phải là mã đầu tiên. Lấy mã này cộng thêm 1.

2. dùng ADO. Câu SQL đại khái là
" Select Max(maNV) From RangeCanDoKhongSapXep Where maNV Like '" & maKT & "*' "
Nếu cái recordset trả về null thì đây là mã đầu tiên.
Nếu không null thì lấy mã ấy cộng thêm 1.
 
Bị lỗi không chạy đượcc ạ !!! hỗ trợ giúp mình bạn nhé
cảm ơn bạn nhiều ạ !!!
HeSanbi đã viết:
Bạn tham khảo sử dụng hàm dưới đây:

Sử dụng cho ô:
=NameToCode(C2)

Sử dụng cho cả cột:
=S_NameToCode(C2:C10000,False)

Nếu viết Hoa thì: =S_NameToCode(C2:C10000,TRUE)

Nếu tên phân cách là dấu gạch (-) thì: =S_NameToCode(C2:C10000,False,"-")

Nếu trùng tên bắt đầu từ số 0 hoặc ... thì: =S_NameToCode(C2:C10000,False,"-",1)

Nếu định dạng nhiều số 0 thì: =S_NameToCode(C2:C10000,False,"-",1, "0000")

---------------------------------
JavaScript: 
Option Explicit

#If VBA7 Then
  Private Declare PtrSafe Function SetTimer Lib "user32" (ByVal HWnd As LongPtr, ByVal nIDEvent As LongPtr, ByVal uElapse As LongPtr, ByVal lpTimerFunc As LongPtr) As Long
  Private Declare PtrSafe Function KillTimer Lib "user32" (ByVal HWnd As LongPtr, ByVal nIDEvent As LongPtr) As Long
#Else
  Private Declare Function SetTimer Lib "user32" (ByVal HWnd As Long, ByVal nIDEvent As Long, ByVal uElapse As Long, ByVal lpTimerFunc As Long) As Long
  Private Declare Function KillTimer Lib "user32" (ByVal HWnd As Long, ByVal nIDEvent As Long) As Long
#End If

'///////////////////////////////////////////////////////
#If Win64 Then
  Private gTimerID As LongPtr, gTimerID2 As LongPtr
#Else
  Private gTimerID As Long, gTimerID2 As Long
#End If
'///////////////////////////////////////////////////////
Private NameToCode_OArgs(), NameToCode_OIndex As Integer

Function S_NameToCode(ByVal values As Range, _
             Optional ByVal upper As Boolean, _
             Optional ByVal Delimiter As String = " ", _
             Optional ByVal CodeNumberStart As Long = 0, _
             Optional ByVal Format As String = "000") As Variant
  On Error Resume Next
  KillTimer 0&, gTimerID: gTimerID = 0
  '-----------------------------------------------
  Dim d As Object
  S_NameToCode = NameToCode(CStr(values(1, 1).value), upper, Delimiter, CodeNumberStart, Format, d)
  '-----------------------------------------------
  If values.Cells.Count > 1 Then
    Dim UB As Integer, K As Integer
    '-----------------------------------------------
    UB = UBound(NameToCode_OArgs, 2): K = UB
    K = K + 1
    ReDim Preserve NameToCode_OArgs(1 To K)
    NameToCode_OArgs(K) = Array(values, upper, Delimiter, CodeNumberStart, Format, d, Application.Caller)
    gTimerID = SetTimer(0&, 0&, 1, AddressOf S_NameToCode_callback)
  End If
End Function
'///////////////////////////////////////////////////////
Private Sub S_NameToCode_callback()
  On Error Resume Next
  Call KillTimer(0&, gTimerID): gTimerID = 0
  Call KillTimer(0&, gTimerID2): gTimerID2 = 0
  On Error GoTo 0
  '----------------------------------
  Dim UA As Integer
  UA = UBound(NameToCode_OArgs)
  If UA > 0 Then
    NameToCode_OIndex = NameToCode_OIndex + 1
    '-------------------------------------------
    Dim Args, R As Long, C As Integer, total(), total2(), UB As Long, UB2 As Integer
    Dim d As Object, upper As Boolean, Delimiter As String, Format As String, CodeNumberStart As Long
    Dim Rng As Range
    Args = NameToCode_OArgs(NameToCode_OIndex)
    Set Rng = Args(0)
    UB = Rng(Rng.Rows.Count + 2, 1).End(3).Row - Rng.Row + 1
    If UB > 0 Then
      Args(0) = Rng(1, 1).Resize(UB, Rng.Columns.Count).value
      Set d = Args(5): upper = Args(1): Delimiter = Args(2): Format = Args(4)
      CodeNumberStart = Args(3)
      UB2 = UBound(Args(0), 2)
      ReDim total(2 To Rng.Rows.Count, 1 To UB2)
      For R = 2 To UB
        For C = 1 To UB2
          If Args(0)(R, C) <> "" Then
            total(R, C) = NameToCode(CStr(Args(0)(R, C)), upper, Delimiter, CodeNumberStart, Format, d)
          End If
        Next
      Next
      Args(6)(2, 1).Resize(UBound(total) - 1, UB2).value = total
      If UB2 > 1 Then
        ReDim total2(1 To 1, 2 To UB2)
        For C = 2 To UB2
          If Args(0)(1, C) <> "" Then
            total2(1, C) = NameToCode(CStr(Args(0)(1, C)), upper, Delimiter, CodeNumberStart, Format, d)
          End If
        Next
        Args(6)(1, 2).Resize(, UB2 - 1).value = total2
      End If
    End If
    '-------------------------------------------
    If NameToCode_OIndex >= UA Then
      Erase NameToCode_OArgs: NameToCode_OIndex = 0
    Else
      gTimerID = SetTimer(0&, 0&, 1, AddressOf S_NameToCode_callback2)
    End If
  End If
End Sub
Private Sub S_NameToCode_callback2()
  S_NameToCode_callback
End Sub
Function NameToCode(Text As String, _
    Optional ByVal upper As Boolean, _
    Optional ByVal Delimiter As String = " ", _
    Optional ByVal CodeNumberStart As Long = 0, _
    Optional ByVal strFormat As String = "000", _
    Optional ByRef DList As Object) As Variant
  If Text = "" Then NameToCode = "": Exit Function
  Dim a As String, e As String, i As String, o As String, u As String, y As String, d As String
  a = "[aA" & ChrW(224) & ChrW(225) & ChrW(226) & ChrW(227) & ChrW(259) & ChrW(7841) & ChrW(7843) & ChrW(7845) & ChrW(7847) & ChrW(7849) & ChrW(7851) & ChrW(7853) & ChrW(7855) & ChrW(7857) & ChrW(7859) & ChrW(7861) & ChrW(7863) & ChrW(65) & ChrW(192) & ChrW(193) & ChrW(194) & ChrW(195) & ChrW(258) & ChrW(7840) & ChrW(7842) & ChrW(7844) & ChrW(7846) & ChrW(7848) & ChrW(7850) & ChrW(7852) & ChrW(7854) & ChrW(7856) & ChrW(7858) & ChrW(7860) & ChrW(7862) & "]"
  e = "[eE" & ChrW(232) & ChrW(233) & ChrW(234) & ChrW(7865) & ChrW(7867) & ChrW(7869) & ChrW(7871) & ChrW(7873) & ChrW(7875) & ChrW(7877) & ChrW(7879) & ChrW(200) & ChrW(201) & ChrW(202) & ChrW(7864) & ChrW(7866) & ChrW(7868) & ChrW(7870) & ChrW(7872) & ChrW(7874) & ChrW(7876) & ChrW(7878) & "]"
  i = "[iI" & ChrW(236) & ChrW(237) & ChrW(297) & ChrW(7881) & ChrW(7883) & ChrW(204) & ChrW(205) & ChrW(296) & ChrW(7880) & ChrW(7882) & "]"
  o = "[oO" & ChrW(242) & ChrW(243) & ChrW(244) & ChrW(245) & ChrW(417) & ChrW(7885) & ChrW(7887) & ChrW(7889) & ChrW(7891) & ChrW(7893) & ChrW(7895) & ChrW(7897) & ChrW(7899) & ChrW(7901) & ChrW(7903) & ChrW(7905) & ChrW(7907) & ChrW(210) & ChrW(211) & ChrW(212) & ChrW(213) & ChrW(416) & ChrW(7884) & ChrW(7886) & ChrW(7888) & ChrW(7890) & ChrW(7892) & ChrW(7894) & ChrW(7896) & ChrW(7898) & ChrW(7900) & ChrW(7902) & ChrW(7904) & ChrW(7906) & "]"
  u = "[uU" & ChrW(249) & ChrW(250) & ChrW(361) & ChrW(432) & ChrW(7909) & ChrW(7911) & ChrW(7913) & ChrW(7915) & ChrW(7917) & ChrW(7919) & ChrW(7921) & ChrW(217) & ChrW(218) & ChrW(360) & ChrW(431) & ChrW(7908) & ChrW(7910) & ChrW(7912) & ChrW(7914) & ChrW(7916) & ChrW(7918) & ChrW(7920) & "]"
  y = "[yY" & ChrW(253) & ChrW(7923) & ChrW(7925) & ChrW(7927) & ChrW(7929) & ChrW(221) & ChrW(7922) & ChrW(7924) & ChrW(7926) & ChrW(7928) & "]"
  d = "[dD" & ChrW(273) & ChrW(272) & "]"
  Dim S1 As String, S2 As String, s As String, SP() As String
  Dim L1 As Integer, L2 As Integer
  SP = Split(Text, Delimiter): L2 = UBound(SP)
  For L1 = 0 To L2
    S1 = LCase(Left(SP(L1), 1))
    Select Case True
    Case S1 Like a: S1 = "a"
    Case S1 Like e: S1 = "e"
    Case S1 Like i: S1 = "i"
    Case S1 Like o: S1 = "o"
    Case S1 Like u: S1 = "u"
    Case S1 Like y: S1 = "y"
    Case S1 Like d: S1 = "d"
    End Select
    SP(L1) = S1
  Next
  S2 = Join(SP, ""):
  If DList Is Nothing Then
    Set DList = VBA.CreateObject("Scripting.Dictionary")
    DList.compareMode = 1
  Else
    While DList.exists(S2 & Format(CodeNumberStart, strFormat))
      CodeNumberStart = CodeNumberStart + 1
    Wend
  End If
  NameToCode = S2 & Format(CodeNumberStart, "000")
  If upper Then NameToCode = UCase(NameToCode)
  DList(NameToCode) = CodeNumberStart
End Function
Nhấp chuột vào đây để mở rộng...
 

File đính kèm

  • Book1.xlsm
    20.9 KB · Đọc: 5
  • Untitled.png
    Untitled.png
    323.9 KB · Đọc: 14
  • Untitled1.png
    Untitled1.png
    17.7 KB · Đọc: 7
. . . . .
Có 3 ký tự rồi thì bạn dò bảng mã để xem có hay chưa. Nếu có rồi thì tăng số lên. Như vậy thôi.
Bạn có hai cách dò. Cách thứ nhất giản dị về code nhưng đòi hỏi bạn phải sắp xếp bảng. Cách thứ hai không cần sắp xếp bảng nhưng đòi bỏi bạn phải viết code ADO.
1 Ví dụ tên nhân viên cho bạn được mã "tvt" chứa trong biến maKT.
. . . . .
Nhấp chuột vào đây để mở rộng...
Có thể xài cách giản dị, nhưng không cần sắp xếp cột mã NV, đó là áp dụng phương thức FIND() kèm với việc khai báo thêm 1 tham biến kiểu Integer ghi lại trị Max của 3 kí số sau cùng của từng mã trùng trong quá trình duyệt cột mã NV này.

STTMã NVHọ & Tên
1CMN01Cỗ Mai Nam
2CMN00Công Tằng Tôn Nữ Minh Nguyệt
3FFD00Đỗ Thái Đức Dương
4DFF00Dương Đình Đức
5LJB00Li Bin
6NFS00Ngô Đình Sơn
7NVH01Ngô Thị Việt Hà
8NVH00Ngô Viết Hòa
9NVH03Nguyễn Võ Hoàng
10NVH02Nguyễn Vũ Hải
11TTH00Tô Thị Hà
12TAN00Trần Ánh Ngọc

PHP: 
Sub TimMaNhanVienKeTiep()
 Dim Rng As Range, sRng As Range
 Dim Rws As Long, Max_ As Integer, Tmp As Integer
 Dim MyAdd As String
 
 Rws = [b1].CurrentRegion.Rows.Count
 Set Rng = [b1].Resize(Rws)
 Set sRng = Rng.Find("NVH", , xlFormulas, xlPart)
 If Not sRng Is Nothing Then
    MyAdd = sRng.Address
    Do
        Tmp = CInt(Right(sRng.Value, 2))
        If Tmp > Max_ Then
            Max_ = Tmp
        End If
        Set sRng = Rng.FindNext(sRng)
    Loop While Not sRng Is Nothing And sRng.Address <> MyAdd
    MsgBox Max_ + 1
 End If
End Sub
 
Lần chỉnh sửa cuối:
Thanhhoai00 đã viết:
Mình có đoạn code sau
Khi chạy xong đã tạo được mã nhân viên bằng cách lấy chữ cái đầu dòng của họ + tên lót + tên
Nhưng khi chạy ra mã nhân viên bị trùng nhau, các bạn có cách nào code để tạo ra mã dạng như
Nvt001, nvt002,nvt003
...............................
Trần văn tý. > tvt001
Trần văn tèo. > Tvt002
................................
Phạm thị phượng > Ptp001
Phạm thị phương >Ptp002
Phạm thanh phong >Ptp003
...............
Giúp mình nhé ! Cảm ơn các bạn !!!
Mã: 
Function Firstchar(Str As String) As String
Dim i As Byte
Str = Trim(Str): Firstchar = Left(Str, 1)
For i = 1 To Len(Str)
    If Mid(Str, i, 1) = " " Then Firstchar = Firstchar + Mid(Str, i + 1, 1)
Next
End Function
Sub an()
Dim i As Integer
For i = 2 To 100 ' n là dòng cu?i d? li?u
Range("B" & i).Value = Firstchar(Range("C" & i).Value)
Next i
End Sub
Nhấp chuột vào đây để mở rộng...
Bạn xem file đính kèm nha.
Một số code mình lấy/dựa trên các bạn trên GPE này . Xin Cám ơn tất cả.
Mình làm cơ bản theo các ý kiến chung của mọi người:
1/ độ dài Mã NV cố định =7
2/ Index khi có trùng lặp là 3 chữ số
3/a>nếu tên nhân viên có dưới 4 chữ thì sẽ bù số 0 vào (phía sau) VD: Bạch Tinh => Mã sẽ là BT00001
b>nếu tên nhân viên có đúng 4 chữ thì lấy trọn. VD: Châu Thanh Tì Hoãn => Mã sẽ là CTTH001
c> Nếu tên nhân viên có trên 4 chữ thì lấy chữ đầu tiên + 3 chữ cuối cùng. VD: Châu Thanh Trì Hoãn Binh=> Mã sẽ là CTHB001
Bạn điền tên vào cột C thì tự ra mã nhân viên cột B.
 

File đính kèm

  • NameToCode-GPE.xlsm
    24.1 KB · Đọc: 19
Code hay quá. Cảm ơn bạn nhiều nhiều ạ !!!
thnghiachau đã viết:
Bạn xem file đính kèm nha.
Một số code mình lấy/dựa trên các bạn trên GPE này . Xin Cám ơn tất cả.
Mình làm cơ bản theo các ý kiến chung của mọi người:
1/ độ dài Mã NV cố định =7
2/ Index khi có trùng lặp là 3 chữ số
3/a>nếu tên nhân viên có dưới 4 chữ thì sẽ bù số 0 vào (phía sau) VD: Bạch Tinh => Mã sẽ là BT00001
b>nếu tên nhân viên có đúng 4 chữ thì lấy trọn. VD: Châu Thanh Tì Hoãn => Mã sẽ là CTTH001
c> Nếu tên nhân viên có trên 4 chữ thì lấy chữ đầu tiên + 3 chữ cuối cùng. VD: Châu Thanh Trì Hoãn Binh=> Mã sẽ là CTHB001
Bạn điền tên vào cột C thì tự ra mã nhân viên cột B.
Nhấp chuột vào đây để mở rộng...
 
Thanhhoai00
Tôi viết code cho bạn là một công thức EXCEL được viết với VBA, bạn chỉ cần gõ vào Ô B2:
=S_NameToCode(C2:C10000)

Vì là công thức nên tự động hoàn toàn.
 
Mình muốn gán công thức cho hàm S_NameToCode để hàm này trả về giá trị tại ô B2 luôn , không cần ra ngoài gọi hàm này nữa,thì code trong vba mình viết như thế nào ạ !!!! Cảm ơn bạn nhiều ạ !!!
S_NameToCode(C2:C10000)


HeSanbi đã viết:
Thanhhoai00
Tôi viết code cho bạn là một công thức EXCEL được viết với VBA, bạn chỉ cần gõ vào Ô B2:
=S_NameToCode(C2:C10000)

Vì là công thức nên tự động hoàn toàn.
Nhấp chuột vào đây để mở rộng...
 
Lần chỉnh sửa cuối:
Bạn phải đăng nhập hoặc đăng ký để trả lời bài viết tại đây.
Web KT

Bài viết mới nhất

Maika8008
Tặng file quản lý vật tư - công nợ (nhập xuất kho hàng và công nợ khách hàng)
    • Thích
    • Yêu thích
    • Cảm ơn
4 5 6
Trả lời
111
Đọc
19K
Hoàng Tuấn 868
H
phanmoi688
[Xin nhờ giúp đỡ] Cách đối chiếu dữ liệu giữa hai biểu
    • Thích
Trả lời
12
Đọc
136
HUONGHCKT
H
V
  • Question
Tìm kiếm và copy giá trị từ bảng đến bảng khác
Trả lời
3
Đọc
48
BuiQuangThuan
B
O
Nhờ sửa code tự động trừ đi một giá trị trong vùng được chọn
Trả lời
5
Đọc
75
ohlexus
O
H
  • Question
Em nhờ các bác làm giúp em in và lưu lịch sử lệnh sản xuất
Trả lời
7
Đọc
209
hiv174
H
Xem thêm…

Facebook

Giaiphapexcel.com

Group

DIỄN ĐÀN GIẢI PHÁP EXCEL

Thành viên có số lượng bài viết cao nhất tháng

Thành viên có điểm tương tác cao nhất tháng

Back
Top Bottom