Đánh số phiếu kế toán theo ngày và mã đơn vị

LanAnh19 · 8/6/22

Nhờ các bạn tạo code cho đánh số phiếu kế toán theo ngày và mã đơn vị
Đánh số phiếu theo quy ước:
1/ Nếu những hàng liền kề nhau mà có cùng ngày tháng và mã đơn vị thì đánh cùng số phiếu
2/ Ví dụ số phiếu: PKT001/06 được quy ước là
* 001 số thứ tự phát sinh trong tháng (số từ 001 đến 999, trong 1 tháng)
*06 là tháng của ngày tháng phát sinh (01/06/2022)
Nhờ các bạn giúp đỡ. Xin cảm ơn nhiều

CHAOQUAY · 8/6/22

LanAnh19 đã viết:
Nhờ các bạn tạo code cho đánh số phiếu kế toán theo ngày và mã đơn vị
Đánh số phiếu theo quy ước:
1/ Nếu những hàng liền kề nhau mà có cùng ngày tháng và mã đơn vị thì đánh cùng số phiếu
2/ Ví dụ số phiếu: PKT001/06 được quy ước là
* 001 số thứ tự phát sinh trong tháng (số từ 001 đến 999, trong 1 tháng)
*06 là tháng của ngày tháng phát sinh (01/06/2022)
Nhờ các bạn giúp đỡ. Xin cảm ơn nhiều

............................................

Mã:

Option Explicit

Sub xxx()
Dim MaNgay
Dim phieuSo
Dim i, j

MaNgay = Sheet1.Range("B8:C16")
ReDim phieuSo(1 To UBound(MaNgay) - 1, 1 To 1)

For i = 2 To UBound(MaNgay)
    If MaNgay(i, 1) <> MaNgay(i - 1, 1) Or MaNgay(i, 2) <> MaNgay(i - 1, 2) Then
        j = j + 1
    End If
    phieuSo(i - 1, 1) = "PTK-" & Right(1000 + j, 3) & "/" & Right(100 + Month(MaNgay(i, 1)), 2)
Next i

Sheet1.Range("A9").Resize(UBound(phieuSo), UBound(phieuSo, 2)) = phieuSo
End Sub

LanAnh19 · 8/6/22

CHAOQUAY đã viết:

............................................

Mã:

Option Explicit

Sub xxx()
Dim MaNgay
Dim phieuSo
Dim i, j

MaNgay = Sheet1.Range("B8:C16")
ReDim phieuSo(1 To UBound(MaNgay) - 1, 1 To 1)

For i = 2 To UBound(MaNgay)
    If MaNgay(i, 1) <> MaNgay(i - 1, 1) Or MaNgay(i, 2) <> MaNgay(i - 1, 2) Then
        j = j + 1
    End If
    phieuSo(i - 1, 1) = "PTK-" & Right(1000 + j, 3) & "/" & Right(100 + Month(MaNgay(i, 1)), 2)
Next i

Sheet1.Range("A9").Resize(UBound(phieuSo), UBound(phieuSo, 2)) = phieuSo
End Sub

Sao tôi thêm dữ liệu vào mà nó không chạy vậy bạn?

Tình nghĩa giang hồ · 8/6/22

LanAnh19 đã viết:
Sao tôi thêm dữ liệu vào mà nó không chạy vậy bạn?

Mình thêm tí vào code anh ChaoQuay là được bạn

Sub xxx()
Dim MaNgay
Dim phieuSo
Dim i, j
Dim lr As Long
lr = Sheet1.Range("C" & Rows.Count).End(xlUp).Row
MaNgay = Sheet1.Range("B8:C" & lr)
ReDim phieuSo(1 To UBound(MaNgay) - 1, 1 To 1)

For i = 2 To UBound(MaNgay)
If MaNgay(i, 1) <> MaNgay(i - 1, 1) Or MaNgay(i, 2) <> MaNgay(i - 1, 2) Then
j = j + 1
End If
phieuSo(i - 1, 1) = "PTK-" & Right(1000 + j, 3) & "/" & Right(100 + Month(MaNgay(i, 1)), 2)
Next i

Sheet1.Range("A9").Resize(UBound(phieuSo), UBound(phieuSo, 2)) = phieuSo

End Sub

CHAOQUAY · 8/6/22

LanAnh19 đã viết:
Sao tôi thêm dữ liệu vào mà nó không chạy vậy bạn?

Có lẽ là nó không chạy từ dòng 17 trở đi thôi, còn từ dòng 16 trở lên chắc là chạy bình thường.
Đây là do code chỉ tạm lấy vùng dữ liệu đến dòng 16 nên nó vậy, bạn sửa như của @Tình nghĩa giang hồ là được

LanAnh19 · 8/6/22

Đúng rồi, cảm ơn các bạn nhiều

Bài đã được tự động gộp: 8/6/22

CHAOQUAY đã viết:
Có lẽ là nó không chạy từ dòng 17 trở đi thôi, còn từ dòng 16 trở lên chắc là chạy bình thường.
Đây là do code chỉ tạm lấy vùng dữ liệu đến dòng 16 nên nó vậy, bạn sửa như của @Tình nghĩa giang hồ là được

Bạn giúp mình sửa lại 1 chút (xin lỗi do tôi mô tả chưa rỏ)
Nếu qua tháng mới thì số phiếu bắt đầu là 001/tháng
Code hiện tại đang đánh số liên tục qua các tháng
xin xem file. Cảm ơn rất nhiều ạ!

bebo021999 · 8/6/22

Lưu ý là bảng này dùng trong 1 năm. Nếu qua năm sau thì số phiếu sẽ trùng nhé.

PHP:

Option Explicit
Sub test()
Dim lr&, count&, k&, cell As Range, arr()
lr = Cells(Rows.count, "B").End(xlUp).Row
ReDim arr(1 To lr - 8, 1 To 1)
On Error Resume Next
For Each cell In Range("B9:B" & lr)
    k = k + 1
    If Month(cell) <> Month(cell.Offset(-1, 0)) Then
        count = 1
        ElseIf Not (cell = cell.Offset(-1, 0) And cell.Offset(0, 1) = cell.Offset(-1, 1)) Then count = count + 1
    End If
    arr(k, 1) = "PKT-" & Format(count, "000") & "/" & Format(Month(cell), "00")
Next
Range("A9").Resize(k, 1).Value = arr
End Sub

CHAOQUAY · 8/6/22

LanAnh19 đã viết:
Đúng rồi, cảm ơn các bạn nhiều

Bài đã được tự động gộp: 8/6/22

Bạn giúp mình sửa lại 1 chút (xin lỗi do tôi mô tả chưa rỏ)
Nếu qua tháng mới thì số phiếu bắt đầu là 001/tháng
Code hiện tại đang đánh số liên tục qua các tháng
xin xem file. Cảm ơn rất nhiều ạ!

Bạn test code dưới đây. "PTK" đã sửa thành "PKT"

Mã:

Option Explicit


Sub PKT()
Dim MaNgay
Dim phieuSo
Dim i, j, k
Dim lr As Long

lr = Sheet1.Range("C" & Rows.Count).End(xlUp).Row
MaNgay = Sheet1.Range("B8:C" & lr)
ReDim phieuSo(1 To UBound(MaNgay) - 1, 1 To 1)

For i = 2 To UBound(MaNgay)
    If Month(MaNgay(i, 1)) <> k Then
        j = 1
        k = Month(MaNgay(i, 1))
    Else
        If MaNgay(i, 1) <> MaNgay(i - 1, 1) Or MaNgay(i, 2) <> MaNgay(i - 1, 2) Then
            j = j + 1
        End If
    End If
    phieuSo(i - 1, 1) = "PKT-" & Right(1000 + j, 3) & "/" & Right(100 + Month(MaNgay(i, 1)), 2)
Next i

Sheet1.Range("A9").Resize(UBound(phieuSo), UBound(phieuSo, 2)) = phieuSo

End Sub

hichlehg · 8/6/22

Mình sử dụng công thức. Bạn xem vậy có đúng như ý bạn chưa?

LanAnh19 · 8/6/22

bebo021999 đã viết:

Lưu ý là bảng này dùng trong 1 năm. Nếu qua năm sau thì số phiếu sẽ trùng nhé.

PHP:

Option Explicit
Sub test()
Dim lr&, count&, k&, cell As Range, arr()
lr = Cells(Rows.count, "B").End(xlUp).Row
ReDim arr(1 To lr - 8, 1 To 1)
On Error Resume Next
For Each cell In Range("B9:B" & lr)
    k = k + 1
    If Month(cell) <> Month(cell.Offset(-1, 0)) Then
        count = 1
        ElseIf Not (cell = cell.Offset(-1, 0) And cell.Offset(0, 1) = cell.Offset(-1, 1)) Then count = count + 1
    End If
    arr(k, 1) = "PKT-" & Format(count, "000") & "/" & Format(Month(cell), "00")
Next
Range("A9").Resize(k, 1).Value = arr
End Sub

Cảm ơn anh, qua năm sau em làm sổ kế toán mới

SA_DQ · 8/6/22

LanAnh19 đã viết:
Nhờ các bạn tạo code cho đánh số phiếu kế toán theo ngày và mã đơn vị
Đánh số phiếu theo quy ước:
1/ Nếu những hàng liền kề nhau mà có cùng ngày tháng và mã đơn vị thì đánh cùng số phiếu
2/ Ví dụ số phiếu: PKT001/06 được quy ước là
* 001 số thứ tự phát sinh trong tháng (số từ 001 đến 999, trong 1 tháng)
*06 là tháng của ngày tháng phát sinh (01/06/2022) . . . . . . . .

@Chủ bài đăng: Như vậy số phiếu của bạn luôn có độ dài là 9; Nhưng như vậy cũng luôn có 2 ký tự bất biến là ký tự 'P' & '/'
Thực ra nếu với mình 2 kí tự này sẽ bỏ đi;
Thêm nữa:
a./ Bỡi trong mã luôn có kí tự như 'KT' nên tháng ta nên xài dãy sau '123456789ABC'
Cái tiện của nó không chỉ là rút ngắn bớt 1 ký tự mà sau điểm (b) ta thấy sẻ sắp xếp dữ liệu 1 cách tiện hơn
b./ Bạn nên thêm ký tự biểu thị năm trong số phiếu, như vầy:
KTC6001; Ở đây C chỉ năm 2022, năm sau sẽ là 'D',. . . . .
c./ Bạn nên mã hóa mã đơn vị & thêm vô số phiếu nữa, & như vậy số phiếu của bạn sẽ rất tuyệt với đó nghe!
Bạn thấy thế nào?

Đánh số phiếu kế toán theo ngày và mã đơn vị

LanAnh19

Thành viên chính thức

File đính kèm

CHAOQUAY

Thành viên gắn bó

LanAnh19

Thành viên chính thức

Tình nghĩa giang hồ

Thanh sơn bất cải, lục thủy trường lưu

CHAOQUAY

Thành viên gắn bó

LanAnh19

Thành viên chính thức

File đính kèm

bebo021999

Thành viên gạo cội

CHAOQUAY

Thành viên gắn bó

hichlehg

Thành viên hoạt động

File đính kèm

LanAnh19

Thành viên chính thức

SA_DQ

/(hông là gì!

Bài viết mới nhất

Thành viên có số lượng bài viết cao nhất tháng

Thành viên có điểm tương tác cao nhất tháng