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

Diễn đàn cho mình xin code đặt tên phiếu thu/chi của data trộn lẫn Thu/Chi
Phiếu thu chi phụ thuộc vào 3 ký tự đầu "111" của 2 cột và Tên phiếu phụ thuộc vào Ngày chứng từ và Số chứng từ (Số chứng từ cái có, cái không).
Trong file đính kèm mình có diễn giải và kết quả mong muốn.
Xin cám ơn

Kết quả code khác tí

Sub XYZ()
  Dim sArr(), Res()
  Dim sRow&, i&, thu&, thu2&, chi&, chi2&, ngay$, phieu$

Application.ScreenUpdating = False
  With Sheets("Sheet1")
    i = .Range("B" & Rows.Count).End(xlUp).Row
    .Range("H2") = 1
    .Range("H2:H" & i).DataSeries
    .Range("B2:I" & i).Sort .Range("B2"), 1, .Range("C2"), , 1, Header:=xlNo
    sArr = .Range("B1:G" & i).Value
    sRow = UBound(sArr)
    ReDim Res(2 To sRow, 1 To 1)
    For i = 2 To sRow
      If sArr(i, 2) = Empty Then
        If Mid(sArr(i, 5), 1, 3) = "111" Then
          thu = thu + 1
          Res(i, 1) = "PT" & Format(sArr(i, 1), "DDMMYY.") & thu
        ElseIf Mid(sArr(i, 6), 1, 3) = "111" Then
          chi = chi + 1
          Res(i, 1) = "PC" & Format(sArr(i, 1), "DDMMYY.") & chi
        End If
      Else
        If sArr(i, 1) <> sArr(i - 1, 1) Or sArr(i, 2) <> sArr(i - 1, 2) Then
          If Mid(sArr(i, 5), 1, 3) = "111" Then
            thu2 = thu2 + 1
            Res(i, 1) = "PTCT" & Format(sArr(i, 1), "DDMMYY.") & thu2
          ElseIf Mid(sArr(i, 6), 1, 3) = "111" Then
            chi2 = chi2 + 1
            Res(i, 1) = "PCCT" & Format(sArr(i, 1), "DDMMYY.") & chi2
          End If
        Else
          Res(i, 1) = Res(i - 1, 1)
        End If
      End If
    Next i
    .Range("A2").Resize(sRow - 1) = Res
    .Range("A2:I" & i).Sort .Range("H2"), 1, Header:=xlNo
    .Range("H2").Resize(sRow - 1) = Empty
  End With
  Application.ScreenUpdating = True
End Sub

www.giaiphapexcel.com/diendan/threads/%C4%90%C3%A1nh-s%E1%BB%91-th%E1%BB%A9-t%E1%BB%B1-nhi%E1%BB%81u-%C4%91i%E1%BB%81u-ki%E1%BB%87n.155885/

Nhân tiện cho mình hỏi nếu mình muốn tìm số phiếu lớn nhất của từng loại PTCT, PT, PCCT, PC thì lấy thế nào.
Với mình có 1 lệnh in hàng loạt các tên phiếu này bằng cách dùng vòng lặp nhưng khổ cái là 1 phiếu có thể có nhiều dòng nên nó in mỗi dòng 1 phiếu, ko biết làm thế nào chỉ để nó chỉ nhận 1 lần.

ActiveSheet.PageSetup.PrintArea = "$A$1:$O$26"
Dim Cll As Range
Dim SoChungTu As Range
Set SoChungTu = Sheets("Nhaplieu").Range("A2:A10000")
For Each Cll in SoChungTu
if Left(Cll,4) = "PCHD" Then
Sheet("In").Range("M5") = Cll
ActiveWindow.SelectedSheets.PrintOut
End if
Next Cll

Phải dùng 1 vòng lặp nữa bên trong để lấy hết các dòng phiếu có cùng số.
Có 2 cách:
1. Để nguyên lộn xộn như bạn thì phải duyệt từ Cll xuống đến hết dữ liệu, thấy có cùng số thì lấy thông tin
2. Sắp xếp trước rồi duyệt từ Cll đến khi khác Cll thì ngừng

Tất nhiên 2 nhanh hơn 1 nhiều.

Khóa học SprinGO phù hợp

Khoá học Trưởng phòng nhân sự

Nguồn nhân lực là một trong Tứ trụ kinh doanh của doanh nghiệp, có tác động tới sự tồn tại và phát triển bền...

Xem khóa học