Đánh số thứ tự có điều kiện

[nguyenminh121a122]

Anh chị cho em hỏi, nếu em dùng Dictionary như thế nầy thì có thể đảo ngược nó lại không ?. Nếu cùng Key thì không cộng còn khác Key thì cộng.
Xin anh chị xem giúp, Xin cảm ơn !

 

[batman1]

Nếu tôi đoán đúng ý thì là

Public Sub GPE()
Dim Dic As Object, sArr(), dArr(), I As Long, Tem As String, sct As String, count As Long
Set Dic = CreateObject("Scripting.Dictionary")
sArr = Range([A3], [C3].End(xlDown)).Value            ' .Resize(, 3).Value
ReDim dArr(1 To UBound(sArr, 1), 1 To 1)
For I = 1 To UBound(sArr, 1)
    Tem = sArr(I, 1) & sArr(I, 2)
    If Not Dic.Exists(Tem) Then
        count = count + 1
        sct = "P" & sArr(I, 3) & Format(sArr(I, 1), "yymm") & Format(count, "000")
        Dic.Add Tem, sct
        dArr(I, 1) = sct
    Else
        dArr(I, 1) = Dic.Item(Tem)
    End If
Next I
[D3].Resize(UBound(dArr, 1)) = dArr
Set Dic = Nothing
End Sub

Hoặc chỉ dùng 1 mảng sArr

Public Sub GPE()
Dim Dic As Object, sArr(), I As Long, Tem As String, sct As String, count As Long
Set Dic = CreateObject("Scripting.Dictionary")
sArr = Range([A3], [C3].End(xlDown)).Value
For I = 1 To UBound(sArr, 1)
    Tem = sArr(I, 1) & sArr(I, 2)
    If Not Dic.Exists(Tem) Then
        count = count + 1
        sct = "P" & sArr(I, 3) & Format(sArr(I, 1), "yymm") & Format(count, "000")
        Dic.Add Tem, sct
        sArr(I, 1) = sct
    Else
        sArr(I, 1) = Dic.Item(Tem)
    End If
Next I
[D3].Resize(UBound(sArr, 1)) = sArr
Set Dic = Nothing
End Sub

 

[nguyenminh121a122]

Dạ cảm ơn anh, em mới vừa xem xong. Thấy đúng ý lắm anh ạ. !!!!!!

 

[HieuCD]

Dạ cảm ơn anh, em mới vừa xem xong. Thấy đúng ý lắm anh ạ. !!!!!!

Trời ạ, lần đầu thấy đánh số thứ tự chứng từ không phân biệt phiếu thu phiếu chi

Sub ABC()
  Dim Dic As Object, sArr(), i&, sRow&, pt&, pc&, iKey$, sct$
 
  Set Dic = CreateObject("Scripting.Dictionary")
  With Sheet1
    i = .Range("A" & Rows.count).End(xlUp).Row
    If i < 3 Then MsgBox ("Kong co du lieu!"): Exit Sub
    sArr = .Range("A3:C" & i).Value
  End With
  sRow = UBound(sArr, 1)
  For i = 1 To sRow
    iKey = sArr(i, 1) & "|" & sArr(i, 2) & "|" & sArr(i, 3)
    If Not Dic.Exists(iKey) Then
      If UCase(sArr(i, 3)) = "T" Then
        pt = pt + 1
        sct = "PT" & Format(sArr(i, 1), "yymm") & Format(pt, "000")
      Else
        pc = pc + 1
        sct = "PC" & Format(sArr(i, 1), "yymm") & Format(pc, "000")
      End If
      Dic.Add iKey, sct
      sArr(i, 1) = sct
    Else
      sArr(i, 1) = Dic.Item(iKey)
    End If
  Next i
  Sheet1.Range("D3").Resize(sRow, 1) = sArr
End Sub

Code chỉ viết tạm theo code của bạn, thật ra đánh số chứng từ kiểu nầy trước sau gì cũng bị đuổi việc

 

[VetMini]

... thật ra đánh số chứng từ kiểu nầy trước sau gì cũng bị đuổi việc

Hổng dám đuổi việc đâu. Một đống chứng từ, hồ sơ "tự động" bằng VBA nằm đó. Tôi chắc chắn là chỉ một mình đương sự biết chuyện gì xảy ra (nếu co biết). Đuổi đi rồi ai vào lãnh cái đống rác ấy?

 

[nguyenminh121a122]

Em mới cho chạy thử và kiểm tra thì em thấy lệch ý em ở chỗ là: Nếu sang tháng sau thì phải bắt đầu 1 số mới chứ không phải cộng tiếp thì mình có thay đổi được không vậy anh ?
Ví dụ cuối tháng 01 là PC2101100, thì sang bắt đầu tháng 2 phải là PC2102001.
Cảm ơn anh đã xem bài !!!!

 

[HieuCD]

Em mới cho chạy thử và kiểm tra thì em thấy lệch ý em ở chỗ là: Nếu sang tháng sau thì phải bắt đầu 1 số mới chứ không phải cộng tiếp thì mình có thay đổi được không vậy anh ?
Ví dụ cuối tháng 01 là PC2101100, thì sang bắt đầu tháng 2 phải là PC2102001.
Cảm ơn anh đã xem bài !!!!

Ý như thế nào phải nói rỏ từ đầu, làm mình lo bạn bị đuổi việc không có cơ sở

Sub ABC()
  Dim Dic As Object, sArr(), i&, sRow&, pt&, pc&, iKey$, ym$, sct$
 
  Set Dic = CreateObject("Scripting.Dictionary")
  With Sheet1
    i = .Range("A" & Rows.count).End(xlUp).Row
    If i < 3 Then MsgBox ("Kong co du lieu!"): Exit Sub
    sArr = .Range("A3:C" & i).Value
  End With
  sRow = UBound(sArr, 1)
  For i = 1 To sRow
    If ym <> Format(sArr(i, 1), "yymm") Then
      ym = Format(sArr(i, 1), "yymm")
      pt = 0: pc = 0
    End If
    iKey = sArr(i, 1) & "|" & sArr(i, 2) & "|" & sArr(i, 3)
    If Not Dic.Exists(iKey) Then
      If UCase(sArr(i, 3)) = "T" Then
        pt = pt + 1
        sct = "PT" & ym & Format(pt, "000")
      Else
        pc = pc + 1
        sct = "PC" & ym & Format(pc, "000")
      End If
      Dic.Add iKey, sct
      sArr(i, 1) = sct
    Else
      sArr(i, 1) = Dic.Item(iKey)
    End If
  Next i
  Sheet1.Range("D3").Resize(sRow, 1) = sArr
End Sub

 

[nguyenminh121a122]

Dạ, cảm ơn anh HieuCD đã giúp đỡ xem qua bài. Lúc nào anh HieuCD cũng nhanh lẹ nhất.
Chúc anh HieuCD có nhiều sức khỏe để có nhiều code hây cho mọi người học hỏi thêm nhé.
Xin chân thành cảm ơn !!!!