Xin code tạo mã nhân viên.

huyhungvn · 6/12/12

Xin các cao thủ viết dùm e đoạn code tạo mã nhân viên với điều kiện e đã ghi trong file đính kèm! Thanks.

SA_DQ · 6/12/12

Nếu bạn lập CSDL bên MS ACCESS thì không nói làm gì, còn bên Excel thì nên vầy:

Mã nên có độ dài như nhau;
Mã của nhân vậy này bao gồm mã của nhân vật khác;

Ví dụ Cô Ng. Việt Hồng có mã HNV; Thì cô Ng.Việt Hoa không thể mã là HNV1 được;
Mà cô đầu nên có mã là HNV0

Bạn xem file của mình sẵn có

/(/hững mong giúp bạn ít nhiều!

ndu96081631 · 6/12/12

huyhungvn đã viết:
Xin các cao thủ viết dùm e đoạn code tạo mã nhân viên với điều kiện e đã ghi trong file đính kèm! Thanks.

Trước tiên bạn cần 2 hàm hổ trợ
1> Hàm tách tên:

PHP:

Function NameSplit(ByVal FullName As String, ByVal lType As Long) As String
  Dim tmpArr, Arr()
  Dim Item1 As String, Item2 As String, Item3 As String, tmp As String
  Dim i As Long, n As Long
  ''lType = 1 <==> Lay HO
  ''lType = 2 <==> Lay TÊN LÓT
  ''lType = 3 <==> Lay TÊN
  On Error Resume Next
  FullName = Trim(FullName)
  If Len(FullName) Then
    tmpArr = Split(FullName, " ")
    Item3 = tmpArr(UBound(tmpArr))
    Item1 = tmpArr(0)
    Select Case lType
      Case 1: NameSplit = IIf(UBound(tmpArr) > 0, Item1, "")
      Case 2
        If UBound(tmpArr) > 1 Then
          For i = 1 To UBound(tmpArr) - 1
            tmp = Trim(CStr(tmpArr(i)))
            If Len(tmp) > 0 Then
              n = n + 1
              ReDim Preserve Arr(1 To n)
              Arr(n) = tmp
            End If
          Next
          If n Then NameSplit = Join(Arr, " ")
        End If
      Case 3: NameSplit = Item3
    End Select
  End If
End Function

2> Hàm loại dấu tiếng Việt

PHP:

Function RemoveMarks(ByVal Text As String) As String
  Dim CharCode, i As Long
  Dim ResText As String, sTmp As String
  On Error Resume Next
  sTmp = Text
  CharCode = Array(7855, 7857, 7859, 7861, 7863, 7845, 7847, 7849, 7851, 7853, 225, _
                   224, 7843, 227, 7841, 259, 226, 273, 7871, 7873, 7875, 7877, 7879, _
                   233, 232, 7867, 7869, 7865, 234, 237, 236, 7881, 297, 7883, 7889, _
                   7891, 7893, 7895, 7897, 7899, 7901, 7903, 7905, 7907, 243, 242, _
                   7887, 245, 7885, 244, 417, 7913, 7915, 7917, 7919, 7921, 250, _
                   249, 7911, 361, 7909, 432, 253, 7923, 7927, 7929, 7925)
  ResText = "aaaaaaaaaaaaaaaaadeeeeeeeeeeeiiiiiooooooooooooooooouuuuuuuuuuuyyyyy"
  For i = 0 To UBound(CharCode)
    sTmp = Replace(sTmp, ChrW(CharCode(i)), Mid(ResText, i + 1, 1))
    sTmp = Replace(sTmp, UCase(ChrW(CharCode(i))), UCase(Mid(ResText, i + 1, 1)))
  Next
  RemoveMarks = sTmp
End Function

3> Tiếp theo là code chính:

PHP:

Sub Main()
  Dim sArray, Arr()
  Dim i As Long, n As Long
  Dim lastName As String, tmp As String
  On Error Resume Next
  With Sheets("Sheet1").Range("A3:A1000")
    sArray = .Value
    ReDim Arr(1 To UBound(sArray), 1 To 1)
    With CreateObject("Scripting.Dictionary")
      For i = 1 To UBound(sArray)
        tmp = Trim(CStr(sArray(i, 1)))
        If Len(tmp) Then
          lastName = UCase(NameSplit(tmp, 3))
          lastName = Trim(RemoveMarks(lastName))
          If Not .Exists(lastName) Then
            .Add lastName, 1
            Arr(i, 1) = lastName & 1
          Else
            .Item(lastName) = .Item(lastName) + 1
            Arr(i, 1) = lastName & .Item(lastName)
          End If
        End If
      Next
    End With
    .Offset(, 1).Value = Arr
  End With
End Sub

huyhungvn · 6/12/12

Cám ơn bạn nhiều lắm! Tôi tự kiếm trong diễn đàn mấy ngày rồi mà chưa thấy! Mới đưa sáng nay mà giờ đã có câu trả lời! Diễn đàn có những thành viên quá ưu tú. Thanks ...

huyhungvn · 6/12/12

ndu96081631 đã viết:
Lại nhờ thêm chút nữa ! Bạn đưa code chạy tốt lắm mà do mình không biết về VB nên chưa tự sửa được theo ý. Bạn có thể viết lại theo dạng tạo 1 hàm cho mình xài - hàm(). để có thể chủ động hơn. Thanks.

VetMini · 6/1/13

Hàm lấy riêng họ tên, dùng Regex:

Mã:

Function TachHoTen(ByVal strData As String, Optional ByVal retType As Integer = 3) As String
    
    Dim RE As Object, REMatches As Object
     
    If retType < 1 Or retType > 3 Then
        TachHoTen = "khong co cach tach loai " & retType
        Exit Function
    End If
    
    Set RE = CreateObject("vbscript.regexp")
    With RE
        .MultiLine = False
        .Global = True
        .IgnoreCase = True
        .Pattern = "^([^\s]+\s+)?(.+\s)*([^\s]+$)"
    End With
     
    Set REMatches = RE.Execute(WorksheetFunction.Trim(strData))
    If REMatches.Count > 0 Then
        TachHoTen = Trim(REMatches.Item(0).submatches(retType - 1))
    Else
        TachHoTen = ""
    End If
     
End Function

TachHoTen("Nguyen Van Chuoi Tieu", 3) = "Tieu"
TachHoTen("Nguyen Van Chuoi Tieu", 2) = "Van Chuoi"
TachHoTen("Nguyen Van Chuoi Tieu", 1) = "Nguyen"
TachHoTen("Nguyen Van Tieu", 3) = "Tieu"
TachHoTen("Nguyen Van Tieu", 2) = "Van"
TachHoTen("Nguyen Van Tieu", 1) = "Nguyen"
TachHoTen("Nguyen Tieu", 3) = "Tieu"
TachHoTen("Nguyen Tieu", 2) = ""
TachHoTen("Nguyen Tieu", 1) = "Nguyen"
TachHoTen("Tieu", 3) = "Tieu"
TachHoTen("Tieu", 2) = ""
TachHoTen("Tieu", 1) = ""

Chú thích: rất tiếc là Regex của VBScript không hổ trợ dòm trước, ngó sau (lookahead, lookbehind). Nếu có hổ trợ thì code gọn đẹp hơn nhiều.

huongmuine · 22/4/18

Mình có danh sách học sinh, nhiều khi học sinh chuyển đi rồi lại về sau một thời gian. Do đó có thể sẽ nhập trùng dữ liệu vì đã có dữ liệu trước đó. Mong các anh chị trong diễn đàn viết giúp đoạn code tạo mã cho học sinh ( tự động) để tránh nhập trùng dữ liệu.
Nội dung yêu cầu được ghi trong file.
Xin cảm ơn.

Hoang2013 · 22/4/18

Xin gợi ý bạn bộ mã học sinh như sau:

PHP:

'
[ATTACH=full]194316[/ATTACH]

huongmuine · 22/4/18

Hoang2013 đã viết:
Xin gợi ý bạn bộ mã học sinh như sau:

PHP:

' [ATTACH=full]194316[/ATTACH]

Cảm ơn bạn đã quan tâm và gợi ý cho mình.
Nếu được nhờ bạn có thể giúp mình đoạn code trên.

Hoang2013 · 22/4/18

Macro sẽ tạo giúp bạn cột "Mã 03" & sắp xếp theo thứ tự tăng dần của cột này;
Cột 'Mã 05' do công thức tạo nên

huongmuine · 22/4/18

Hoang2013 đã viết:
Macro sẽ tạo giúp bạn cột "Mã 03" & sắp xếp theo thứ tự tăng dần của cột này;
Cột 'Mã 05' do công thức tạo nên

Xin cảm ơn bạn đã nhiệt tình giúp đỡ.
Chúc bạn buổi tối nhiều niềm vui.

khi ta 20 · 23/4/18

ndu96081631 đã viết:

Trước tiên bạn cần 2 hàm hổ trợ
1> Hàm tách tên:

PHP:

Function NameSplit(ByVal FullName As String, ByVal lType As Long) As String
  Dim tmpArr, Arr()
  Dim Item1 As String, Item2 As String, Item3 As String, tmp As String
  Dim i As Long, n As Long
  ''lType = 1 <==> Lay HO
  ''lType = 2 <==> Lay TÊN LÓT
  ''lType = 3 <==> Lay TÊN
  On Error Resume Next
  FullName = Trim(FullName)
  If Len(FullName) Then
    tmpArr = Split(FullName, " ")
    Item3 = tmpArr(UBound(tmpArr))
    Item1 = tmpArr(0)
    Select Case lType
      Case 1: NameSplit = IIf(UBound(tmpArr) > 0, Item1, "")
      Case 2
        If UBound(tmpArr) > 1 Then
          For i = 1 To UBound(tmpArr) - 1
            tmp = Trim(CStr(tmpArr(i)))
            If Len(tmp) > 0 Then
              n = n + 1
              ReDim Preserve Arr(1 To n)
              Arr(n) = tmp
            End If
          Next
          If n Then NameSplit = Join(Arr, " ")
        End If
      Case 3: NameSplit = Item3
    End Select
  End If
End Function

2> Hàm loại dấu tiếng Việt

PHP:

Function RemoveMarks(ByVal Text As String) As String
  Dim CharCode, i As Long
  Dim ResText As String, sTmp As String
  On Error Resume Next
  sTmp = Text
  CharCode = Array(7855, 7857, 7859, 7861, 7863, 7845, 7847, 7849, 7851, 7853, 225, _
                   224, 7843, 227, 7841, 259, 226, 273, 7871, 7873, 7875, 7877, 7879, _
                   233, 232, 7867, 7869, 7865, 234, 237, 236, 7881, 297, 7883, 7889, _
                   7891, 7893, 7895, 7897, 7899, 7901, 7903, 7905, 7907, 243, 242, _
                   7887, 245, 7885, 244, 417, 7913, 7915, 7917, 7919, 7921, 250, _
                   249, 7911, 361, 7909, 432, 253, 7923, 7927, 7929, 7925)
  ResText = "aaaaaaaaaaaaaaaaadeeeeeeeeeeeiiiiiooooooooooooooooouuuuuuuuuuuyyyyy"
  For i = 0 To UBound(CharCode)
    sTmp = Replace(sTmp, ChrW(CharCode(i)), Mid(ResText, i + 1, 1))
    sTmp = Replace(sTmp, UCase(ChrW(CharCode(i))), UCase(Mid(ResText, i + 1, 1)))
  Next
  RemoveMarks = sTmp
End Function

3> Tiếp theo là code chính:

PHP:

Sub Main()
  Dim sArray, Arr()
  Dim i As Long, n As Long
  Dim lastName As String, tmp As String
  On Error Resume Next
  With Sheets("Sheet1").Range("A3:A1000")
    sArray = .Value
    ReDim Arr(1 To UBound(sArray), 1 To 1)
    With CreateObject("Scripting.Dictionary")
      For i = 1 To UBound(sArray)
        tmp = Trim(CStr(sArray(i, 1)))
        If Len(tmp) Then
          lastName = UCase(NameSplit(tmp, 3))
          lastName = Trim(RemoveMarks(lastName))
          If Not .Exists(lastName) Then
            .Add lastName, 1
            Arr(i, 1) = lastName & 1
          Else
            .Item(lastName) = .Item(lastName) + 1
            Arr(i, 1) = lastName & .Item(lastName)
          End If
        End If
      Next
    End With
    .Offset(, 1).Value = Arr
  End With
End Sub

Hoang2013 · 23/4/18

khi ta 20 đã viết:
???

Bạn nên viết hay góp vài câu chứ, trích dẫn khơi khơi vậy nhằm mục đích gì?

Nói chung ta không nên tạo ra bộ mã có độ dài khác nhau như trong file #01:

Sẽ khó xử nếu trong danh sách có các tên như sau:

huongmuine · 23/4/18

Hoang2013 đã viết:
Macro sẽ tạo giúp bạn cột "Mã 03" & sắp xếp theo thứ tự tăng dần của cột này;
Cột 'Mã 05' do công thức tạo nên

Nhờ bạn kiểm tra lại giúp mình với.
Khi mình đưa danh sách có nhiều dữ liệu hơn vào thì code chạy bị lỗi.
Code bị lỗi tại dòng: Ma = WF.VLookup(Left(Tmp, 1), Tabl, 2, False)
Xin cảm ơn.

Hoang2013 · 23/4/18

Dòng này bị lỗi do 1 trong các nguyên nhân sau:
1./ Có khoảng trống trước [Họ Đêm] khi nhập gây ra; Xem cả bên cột [Tên] nữa nghen.
2./ Có thừa khoảng trống giữa [họ] & [đêm] hay cuối [Họ Đêm]
3./ Bắt macro tra từ không có trong bảng tra.
. . . . .

huongmuine · 23/4/18

Hoang2013 đã viết:
Dòng này bị lỗi do 1 trong các nguyên nhân sau:
1./ Có khoảng trống trước [Họ Đêm] khi nhập gây ra; Xem cả bên cột [Tên] nữa nghen.
2./ Có thừa khoảng trống giữa [họ] & [đêm] hay cuối [Họ Đêm]
3./ Bắt macro tra từ không có trong bảng tra.
. . . . .

Cảm ơn bạn đã chỉ ra cho mình cách khắc phục lỗi.
Chúc bạn trong ngày đầu tuần gặp nhiều thành công.

Hoang2013 · 23/4/18

huongmuine đã viết:
Nhờ bạn giúp mình tí nữa ạ: Khi mình chạy code tạo mã thì dữ liệu cũng bị xáo trộn không như dữ liệu lúc đầu.
Bạn có thể chỉ mình cách thêm mã vào mà không bị xáo trộn dữ liệu so với ban đầu. Xin cảm ơn bạn.

1. Macro thực hiện các công đoạn:
2. Tạo ra 3 kí tự đầu của mã (Fần đặc tính của mã)
3. Sau đó sắp xết theo fần đặc tính này
4. Chỉ sau khi đã sắp xếp, ta mới có thể thêm fần định trị của mã (thường là 2 kí số); Bằng công thức hay câu lệnh macro đều được.

Để đưa về trạng thái ban đầu của dữ liệu của bạn, ta nên làm vầy:
Cần thực hiện tạo cột thứ tự trước khi chạy macro (tạo 3 kí tự đặt tính)
Sau bước 4 nêu trên, ta Copy & dán Values cột mã_05
Sau đó, ta lại xếp danh sách theo trường [STT]

Đó là cách thêm fần định trị bằng công thức;
Nếu làm bỡi macro sẽ đơn giản đi fần nào các bước sắp xếp

Bạn thử sức trước xem sao & chúc thành công!

huongmuine · 23/4/18

Hoang2013 đã viết:
1. Macro thực hiện các công đoạn:
2. Tạo ra 3 kí tự đầu của mã (Fần đặc tính của mã)
3. Sau đó sắp xết theo fần đặc tính này
4. Chỉ sau khi đã sắp xếp, ta mới có thể thêm fần định trị của mã (thường là 2 kí số); Bằng công thức hay câu lệnh macro đều được.

Để đưa về trạng thái ban đầu của dữ liệu của bạn, ta nên làm vầy:
Cần thực hiện tạo cột thứ tự trước khi chạy macro (tạo 3 kí tự đặt tính)
Sau bước 4 nêu trên, ta Copy & dán Values cột mã_05
Sau đó, ta lại xếp danh sách theo trường [STT]

Đó là cách thêm fần định trị bằng công thức;
Nếu làm bỡi macro sẽ đơn giản đi fần nào các bước sắp xếp

Bạn thử sức trước xem sao & chúc thành công!

Cảm ơn bạn đã gợi ý.
Mình hiểu cách thực hiện rồi.

kbw1 · 24/4/18

huongmuine đã viết:
Cảm ơn bạn đã gợi ý.
Mình hiểu cách thực hiện rồi.

Sao bạn không dùng mã Số vậy?

huongmuine · 24/4/18

kbw1 đã viết:
Sao bạn không dùng mã Số vậy?

Nếu dùng mã số, với số lượng dữ liệu lớn thì rất khó khăn trong tìm kiếm.

Xin code tạo mã nhân viên.

Thành viên mới

File đính kèm

/(hông là gì!

File đính kèm

Huyền thoại GPE

File đính kèm

Thành viên mới

Thành viên mới

Ăn cùng góc phố

Thành viên GPE

File đính kèm

Thành viên gắn bó

File đính kèm

Thành viên GPE

Thành viên gắn bó

File đính kèm

Thành viên GPE

Thành viên thường trực

Thành viên gắn bó

File đính kèm

Thành viên GPE

File đính kèm

Thành viên gắn bó

Thành viên GPE

Thành viên gắn bó

Thành viên GPE

Thành viên tích cực

Thành viên GPE

Facebook

Group