Tạo mã số tự động và vấn đề liên quan

[vinh10]

Cả nhà giúp em với ạ. Em muốn điền cho số chạy tự động tăng dần với những tên giống nhau thì sẽ trùng mã số nếu không trùng nhau thì sẽ tiếp tục tăng trùng sẽ lấy mã phía trước, nếu không có tên thì bỏ qua VD mã là: MS00001

 

[bactu]

Cả nhà giúp em với ạ. Em muốn điền cho số chạy tự động tăng dần với những tên giống nhau thì sẽ trùng mã số nếu không trùng nhau thì sẽ tiếp tục tăng trùng sẽ lấy mã phía trước, nếu không có tên thì bỏ qua VD mã là: MS00001

Bạn xem lại trong file có đúng không nhé!

 

[SA_DQ]

Sub TaoMaSach()
 Dim Rng As Range, sRng As Range, Cls As Range
 Dim MyAdd As String, Ma As String
 Dim Rws As Long, DT As Integer, DTr As Integer, Dm As Integer
 
 Rws = [C2].CurrentRegion.Rows.Count
 [A2].Resize(2 * Rws).Value = Space(0)
 For Each Cls In Range([C2], [C432].End(xlUp))
    If Cls.Offset(, -2).Value = Space(0) Then
        Set Rng = Cls.Offset(1).Resize(2 * Rws - DT)
        Set sRng = Rng.Find(Cls.Value, , xlFormulas, xlWhole)
       
        DT = DT + 1
        Cls.Offset(, -2).Value = "GPE" & Right("000" & CStr(DT), 4) & "_00"
        If sRng Is Nothing Then
        Else
            MyAdd = sRng.Address
            Do
                Ma = Cls.Offset(, -2).Value:            DTr = CInt(Right(Ma, 2))
                Dm = Dm + 1
                If sRng.Row <= Rws Then
                    sRng.Offset(, -2).Value = Left(Ma, 7) & "_" & Right("0" & CStr(DTr + Dm), 2)
                End If
                Set sRng = Rng.FindNext(sRng)
            Loop While Not sRng Is Nothing And sRng.Address <> MyAdd
            Dm = 0
        End If
    End If
 Next Cls
End Sub