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

Blue Softs Liên hệ QC

nguyenminh121a122

Thành viên mới
Tham gia
11/5/21
Bài viết
25
Được thích
9
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 !
 

File đính kèm

  • TAO PHIEU TU DONG.xlsm
    20.3 KB · Đọc: 22

batman1

Thành viên gạo cội
Tham gia
8/9/14
Bài viết
4,717
Được thích
7,745
Nếu tôi đoán đúng ý thì là

Mã:
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
Mã:
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
 
Upvote 0

HieuCD

Chuyên gia GPE
Tham gia
14/9/10
Bài viết
8,494
Được thích
17,834
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 :(
Mã:
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
 
Upvote 0

VetMini

Chuyên gia GPE
Tham gia
21/12/12
Bài viết
12,353
Được thích
15,918
... 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?
 
Upvote 0

nguyenminh121a122

Thành viên mới
Tham gia
11/5/21
Bài viết
25
Được thích
9
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 !!!!
 
Upvote 0

HieuCD

Chuyên gia GPE
Tham gia
14/9/10
Bài viết
8,494
Được thích
17,834
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ở :p
Mã:
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
 
Upvote 0

nguyenminh121a122

Thành viên mới
Tham gia
11/5/21
Bài viết
25
Được thích
9
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 !!!!
 
Upvote 0
Top Bottom