Trợ giúp code đánh số chứng từ tự động

[ducmagic88]

Em chào các bác ạ! E đang bập bõm học VBA để phục vụ cho công việc của mình. Gần đây e đang tìm hiểu và viết 1 đoạn code để đánh phiếu nhập (xuất) tự động nhưng tìm hiểu mãi vẫn chưa viết được nên e muốn lên đây nhờ các bác giúp e (và nếu giải thích từng dòng code có chức năng gì được nữa thì e cảm ơn các bác, không thì không cần cũng được ạ). Nội dung : Bắt đầu từ số phiếu 01, nếu số hóa đơn của dòng trên và dưới giống nhau thì cùng số phiếu còn nếu không thì sẽ cộng thêm 1 ạ. E cảm ơn các bác rất nhiều!

 

[nghiaphuc]

Em chào các bác ạ! E đang bập bõm học VBA để phục vụ cho công việc của mình. Gần đây e đang tìm hiểu và viết 1 đoạn code để đánh phiếu nhập (xuất) tự động nhưng tìm hiểu mãi vẫn chưa viết được nên e muốn lên đây nhờ các bác giúp e (và nếu giải thích từng dòng code có chức năng gì được nữa thì e cảm ơn các bác, không thì không cần cũng được ạ). Nội dung : Bắt đầu từ số phiếu 01, nếu số hóa đơn của dòng trên và dưới giống nhau thì cùng số phiếu còn nếu không thì sẽ cộng thêm 1 ạ. E cảm ơn các bác rất nhiều!

Bạn dùng code sau nhé:

Sub DanhSoChungTu()
    Dim i As Long, Rws As Long, Tmp, Arr()
    Rws = Sheet1.[B65000].End(xlUp).Row - 1
    If Rws < 1 Then Exit Sub 'Khong co du lieu
    Tmp = Sheet1.[B2].Resize(Rws).Value 'Lay gia tri
    ReDim Arr(1 To UBound(Tmp))
    Arr(1) = 1 'Danh STT cho phieu dau tien
    For i = 2 To UBound(Tmp)
        If Tmp(i, 1) = Tmp(i - 1, 1) Then 'Giong so hoa don
            Arr(i) = Arr(i - 1)
        Else 'Khac so hoa don
            Arr(i) = Arr(i - 1) + 1
        End If
    Next
    Sheet1.[A2].Resize(Rws) = WorksheetFunction.Transpose(Arr) 'Gan gia tri len sheet
End Sub

 

[ducmagic88]

Bạn dùng code sau nhé:

Sub DanhSoChungTu()
    Dim i As Long, Rws As Long, Tmp, Arr()
    Rws = Sheet1.[B65000].End(xlUp).Row - 1
    If Rws < 1 Then Exit Sub 'Khong co du lieu
    Tmp = Sheet1.[B2].Resize(Rws).Value 'Lay gia tri
    ReDim Arr(1 To UBound(Tmp))
    Arr(1) = 1 'Danh STT cho phieu dau tien
    For i = 2 To UBound(Tmp)
        If Tmp(i, 1) = Tmp(i - 1, 1) Then 'Giong so hoa don
            Arr(i) = Arr(i - 1)
        Else 'Khac so hoa don
            Arr(i) = Arr(i - 1) + 1
        End If
    Next
    Sheet1.[A2].Resize(Rws) = WorksheetFunction.Transpose(Arr) 'Gan gia tri len sheet
End Sub

e cảm ơn bác nhiều ạ

 

[nghiaphuc]

e cảm ơn bác nhiều ạ

Cũng có thể có thêm một cách khác chút xíu:

Sub DanhSoChungTu()
    Dim i As Long, k As Long, Rws As Long, Tmp, Arr()
    Rws = Sheet1.[B65000].End(xlUp).Row - 1
    If Rws < 1 Then Exit Sub 'Khong co du lieu
    Tmp = Sheet1.[B2].Resize(Rws).Value 'Lay gia tri
    ReDim Arr(1 To UBound(Tmp))
    Arr(1) = 1: k = 1 'Danh so cho phieu dau tien
    For i = 2 To UBound(Tmp)
        If Tmp(i, 1) <> Tmp(i - 1, 1) Then k = k + 1 'Khac so hoa don
        Arr(i) = k 'Danh so cho phieu thu i
    Next
    Sheet1.[A2].Resize(Rws) = WorksheetFunction.Transpose(Arr) 'Gan gia tri len sheet
End Sub

 

[ThanhVan88]

Em chào các bác ạ! E đang bập bõm học VBA để phục vụ cho công việc của mình. Gần đây e đang tìm hiểu và viết 1 đoạn code để đánh phiếu nhập (xuất) tự động nhưng tìm hiểu mãi vẫn chưa viết được nên e muốn lên đây nhờ các bác giúp e (và nếu giải thích từng dòng code có chức năng gì được nữa thì e cảm ơn các bác, không thì không cần cũng được ạ). Nội dung : Bắt đầu từ số phiếu 01, nếu số hóa đơn của dòng trên và dưới giống nhau thì cùng số phiếu còn nếu không thì sẽ cộng thêm 1 ạ. E cảm ơn các bác rất nhiều!

Gửi bạn file QLK file đã thiết kế sẵn số phiếu tự động,bạn thao khảo sử dụng file.

 

[babyheomoi]

Gửi bạn file QLK file đã thiết kế sẵn số phiếu tự động,bạn thao khảo sử dụng file.

Bạn có thể cho mình xin pass để chỉnh sửa cho phù hợp không? nếu bất tiện bạn có thể inbox riêng, cám ơn bạn đã share!

 

[ThanhVan88]

Bạn có thể cho mình xin pass để chỉnh sửa cho phù hợp không? nếu bất tiện bạn có thể inbox riêng, cám ơn bạn đã share!

File fix sẵn rồi,bạn sử dụng bt nha.

 

[ducmagic88]

Cũng có thể có thêm một cách khác chút xíu:

Sub DanhSoChungTu()
    Dim i As Long, k As Long, Rws As Long, Tmp, Arr()
    Rws = Sheet1.[B65000].End(xlUp).Row - 1
    If Rws < 1 Then Exit Sub 'Khong co du lieu
    Tmp = Sheet1.[B2].Resize(Rws).Value 'Lay gia tri
    ReDim Arr(1 To UBound(Tmp))
    Arr(1) = 1: k = 1 'Danh so cho phieu dau tien
    For i = 2 To UBound(Tmp)
        If Tmp(i, 1) <> Tmp(i - 1, 1) Then k = k + 1 'Khac so hoa don
        Arr(i) = k 'Danh so cho phieu thu i
    Next
    Sheet1.[A2].Resize(Rws) = WorksheetFunction.Transpose(Arr) 'Gan gia tri len sheet
End Sub

Bác ơi, bác có thể giải thích giúp e tại sao lại phải dùng worksheetFuntion.Transpose k ạ, e hiểu phần trên rồi mà chỗ này k hiểu sao lại transpose. Transpose ở đây có phải là chuyển hàng thành cột k ạ?

 

[ThanhVan88]

Bác ơi, bác có thể giải thích giúp e tại sao lại phải dùng worksheetFuntion.Transpose k ạ, e hiểu phần trên rồi mà chỗ này k hiểu sao lại transpose. Transpose ở đây có phải là chuyển hàng thành cột k ạ?

Bạn tham khảo code này nha,mình có ghi chú dễ hiểu!

Sub NewPhieuN(MaPhieu)
Dim cSoChungTu As Range, fRng As Range, Endrow As Long
Endrow = DATA.Cells(DATA.Rows.Count, "A").End(xlUp).Row 'Xác d?nh dòng cu?i cùng c?t A
Set cSoChungTu = DATA.Range("A2:A" & Endrow) 'Xác d?nh ph?m vi tìm khi?n
Set fRng = cSoChungTu.Find(MaPhieu, , xlValues, xlPart, , xlPrevious, True) 'Thi?t l?p ki?u tìm ki?m
If Not fRng Is Nothing Then '' N?u tìm th?y phi?u g?n nh?t
PNK.Range("G6") = MaPhieu & Format(Right(CStr(fRng.Value), 4) + 1, "0000")
Set fRng = Nothing
Else ' N?u không tìm th?y phi?u g?n nh?t, t?c trong d? li?u chua t?n t?i lo?i phi?u này
PNK.Range("G6") = MaPhieu & "0001" ' Ta t?o phi?u d?u tiên c?a lo?i phi?u dó : N0001 ho?c X0001
End If
Set cSoChungTu = Nothing
End Sub

 

[ducmagic88]

Bạn tham khảo code này nha,mình có ghi chú dễ hiểu!

Sub NewPhieuN(MaPhieu)
Dim cSoChungTu As Range, fRng As Range, Endrow As Long
Endrow = DATA.Cells(DATA.Rows.Count, "A").End(xlUp).Row 'Xác d?nh dòng cu?i cùng c?t A
Set cSoChungTu = DATA.Range("A2:A" & Endrow) 'Xác d?nh ph?m vi tìm khi?n
Set fRng = cSoChungTu.Find(MaPhieu, , xlValues, xlPart, , xlPrevious, True) 'Thi?t l?p ki?u tìm ki?m
If Not fRng Is Nothing Then '' N?u tìm th?y phi?u g?n nh?t
PNK.Range("G6") = MaPhieu & Format(Right(CStr(fRng.Value), 4) + 1, "0000")
Set fRng = Nothing
Else ' N?u không tìm th?y phi?u g?n nh?t, t?c trong d? li?u chua t?n t?i lo?i phi?u này
PNK.Range("G6") = MaPhieu & "0001" ' Ta t?o phi?u d?u tiên c?a lo?i phi?u dó : N0001 ho?c X0001
End If
Set cSoChungTu = Nothing
End Sub

cái này là đánh từng phiếu 1 bác ơi, e muốn đánh hàng loạt kia bác. code của bác nghiaphuc e làm được rồi chỉ là muốn hiểu thì còn dòng cuối là chưa hiểu thôi bác ạ