Tạo số phiếu tự động

Nhật Anh 9x · 16/3/23

Thưa anh chị

Em có ý tưởng muốn tạo số phiếu tự động với điều kiện cần thiết, nếu năm đánh số phiếu khác năm trước thì sẽ đánh lại số phiếu từ đầu
E có sử dụng công thức excel nhưng làm với số lượng dòng trên 10.000 thì chạy rất lâu và file bị đơ
Em có viết code bằng vba nhưng do trình độ còn non, code cũng không được nhanh hơn là mấy
Em gửi file lên mong anh chị xem qua và chỉ dạy cho em với ạ! code e viết ở Module 2 ạ

BuiQuangThuan · 16/3/23

satoshi99 đã viết:
Thưa anh chị

Em có ý tưởng muốn tạo số phiếu tự động với điều kiện cần thiết, nếu năm đánh số phiếu khác năm trước thì sẽ đánh lại số phiếu từ đầu
E có sử dụng công thức excel nhưng làm với số lượng dòng trên 10.000 thì chạy rất lâu và file bị đơ
Em có viết code bằng vba nhưng do trình độ còn non, code cũng không được nhanh hơn là mấy
Em gửi file lên mong anh chị xem qua và chỉ dạy cho em với ạ! code e viết ở Module 2 ạ

Hãy tìm hiểu về mảng để làm so với cách mà bạn đang làm trực tiếp trên sheet

SA_DQ · 16/3/23

Đây là cách của mình, nếu bạn xài được thì xài:

PHP:

Option Explicit
Const Alf As String = "01234546789ABCDEFGHIJKLMNOPQRTSUVWXYZ"
Sub TuDongSoFieu()
 Const TDN As String = "20JL"
 Dim Rws As Long, J As Long, Dat As Date, Tmp As Integer
 Dim SNum As String
 
 Rws = [G10].CurrentRegion.Rows.Count
 For J = 10 To Rws
    Dat = Cells(J, "G").Value
    If Dat > Cells(J - 1, "G").Value Then
        SNum = "00"
    Else
        Tmp = 1 + CInt(Right(Cells(J - 1, "A").Value, 2))
        SNum = Right("0" & CStr(Tmp), 2)
    End If
    Cells(J, "A").Value = MaNgay(Dat) & Cells(J, "Z").Value _
        & TDN & SNum
 Next J
End Sub

Mã:

Function MaNgay(Dat As Date) As String
 Dim Nm As String, Th As String
 
 Nm = Mid(Alf, Year(Dat) - 2008, 1)
 Th = Mid(Alf, 1 + Month(Dat), 1)
 MaNgay = Nm & Th & Mid(Alf, 1 + Day(Dat), 1)
End Function

Nhật Anh 9x · 17/3/23

SA_DQ đã viết:

Đây là cách của mình, nếu bạn xài được thì xài:

PHP:

Option Explicit
Const Alf As String = "01234546789ABCDEFGHIJKLMNOPQRTSUVWXYZ"
Sub TuDongSoFieu()
 Const TDN As String = "20JL"
 Dim Rws As Long, J As Long, Dat As Date, Tmp As Integer
 Dim SNum As String
 
 Rws = [G10].CurrentRegion.Rows.Count
 For J = 10 To Rws
    Dat = Cells(J, "G").Value
    If Dat > Cells(J - 1, "G").Value Then
        SNum = "00"
    Else
        Tmp = 1 + CInt(Right(Cells(J - 1, "A").Value, 2))
        SNum = Right("0" & CStr(Tmp), 2)
    End If
    Cells(J, "A").Value = MaNgay(Dat) & Cells(J, "Z").Value _
        & TDN & SNum
 Next J
End Sub

Mã:

Function MaNgay(Dat As Date) As String
 Dim Nm As String, Th As String
 
 Nm = Mid(Alf, Year(Dat) - 2008, 1)
 Th = Mid(Alf, 1 + Month(Dat), 1)
 MaNgay = Nm & Th & Mid(Alf, 1 + Day(Dat), 1)
End Function

Cảm ơn anh ạ, để em thử ạ!

Bài đã được tự động gộp: 17/3/23

SA_DQ đã viết:

Đây là cách của mình, nếu bạn xài được thì xài:

PHP:

Option Explicit
Const Alf As String = "01234546789ABCDEFGHIJKLMNOPQRTSUVWXYZ"
Sub TuDongSoFieu()
 Const TDN As String = "20JL"
 Dim Rws As Long, J As Long, Dat As Date, Tmp As Integer
 Dim SNum As String
 
 Rws = [G10].CurrentRegion.Rows.Count
 For J = 10 To Rws
    Dat = Cells(J, "G").Value
    If Dat > Cells(J - 1, "G").Value Then
        SNum = "00"
    Else
        Tmp = 1 + CInt(Right(Cells(J - 1, "A").Value, 2))
        SNum = Right("0" & CStr(Tmp), 2)
    End If
    Cells(J, "A").Value = MaNgay(Dat) & Cells(J, "Z").Value _
        & TDN & SNum
 Next J
End Sub

Mã:

Function MaNgay(Dat As Date) As String
 Dim Nm As String, Th As String
 
 Nm = Mid(Alf, Year(Dat) - 2008, 1)
 Th = Mid(Alf, 1 + Month(Dat), 1)
 MaNgay = Nm & Th & Mid(Alf, 1 + Day(Dat), 1)
End Function

Đoạn code này chạy ra không đúng như ý em anh ạ. Số phiếu từ A10 - A15 đánh ra là 1 vì cùng các điều kiện đc xét

bebo021999 · 17/3/23

Dùng thử code này nhé. Có chú thích hướng dẫn bạn đó.
Không hiểu chỗ nào thì la lên nhé
Mình dùng 2 cái dictionary và array (mảng) (Mình nhớ trước đó có nhắc bạn nghiên cứu cách dùng 2 cái này để tránh làm việc trực tiếp trên sheet và tăng tốc độ code)

PHP:

Option Explicit
Sub taoPhieu()
Dim lr&, i&, rng, res()
Dim dic As Object, dic2 As Object, id As String
Set dic = CreateObject("Scripting.Dictionary")
Set dic2 = CreateObject("Scripting.Dictionary")
With Sheets("NhapXuat")
    lr = .Cells(Rows.Count, "G").End(xlUp).Row
    rng = .Range("A10:AA" & lr).value ' luu gia tri cua vung vao array rng
    ReDim res(1 To UBound(rng), 1 To 1) ' tao array res de tao gia tri phieu tai cot A
    For i = 1 To UBound(rng)
        res(i, 1) = Right(rng(i, 7), 2) & "JLP" & rng(i, 26) ' khoi tao phieu = "20JLPNT"
        If Not dic2.exists(rng(i, 26) & Right(rng(i, 7), 2)) Then dic2.Add rng(i, 26) & Right(rng(i, 7), 2), 0 ' tao dic cho NT20,NT21,XS20,...
    Next
    For i = 1 To UBound(rng)
        id = rng(i, 7) & "|" & rng(i, 14) & "|" & rng(i, 27) & "|" & rng(i, 26) ' tao chuoi id khac biet, vd: "02/01/2020|Nhap kho NVL|A45|NT"
        If Not dic.exists(id) Then ' neu chuoi nay xuat hien lan dau thi lay item cua NT20 (key)  = item + 1
            dic2(rng(i, 26) & Right(rng(i, 7), 2)) = dic2(rng(i, 26) & Right(rng(i, 7), 2)) + 1
            dic.Add id, dic2(rng(i, 26) & Right(rng(i, 7), 2))
        End If
        res(i, 1) = res(i, 1) & Format(dic(id), "00000") ' noi chuoi co san "20JLPNT" voi so dem moi, format 5 so
    Next
    .Range("A10:A100000").ClearContents
    .Range("A10").Resize(UBound(res), 1).value = res ' dan mang ket qua res vao sheet, tu o A10
End With
End Sub

Nhật Anh 9x · 17/3/23

bebo021999 đã viết:

Dùng thử code này nhé. Có chú thích hướng dẫn bạn đó.
Không hiểu chỗ nào thì la lên nhé
Mình dùng 2 cái dictionary và array (mảng) (Mình nhớ trước đó có nhắc bạn nghiên cứu cách dùng 2 cái này để tránh làm việc trực tiếp trên sheet và tăng tốc độ code)

PHP:

Option Explicit
Sub taoPhieu()
Dim lr&, i&, rng, res()
Dim dic As Object, dic2 As Object, id As String
Set dic = CreateObject("Scripting.Dictionary")
Set dic2 = CreateObject("Scripting.Dictionary")
With Sheets("NhapXuat")
    lr = .Cells(Rows.Count, "G").End(xlUp).Row
    rng = .Range("A10:AA" & lr).value ' luu gia tri cua vung vao array rng
    ReDim res(1 To UBound(rng), 1 To 1) ' tao array res de tao gia tri phieu tai cot A
    For i = 1 To UBound(rng)
        res(i, 1) = Right(rng(i, 7), 2) & "JLP" & rng(i, 26) ' khoi tao phieu = "20JLPNT"
        If Not dic2.exists(rng(i, 26) & Right(rng(i, 7), 2)) Then dic2.Add rng(i, 26) & Right(rng(i, 7), 2), 0 ' tao dic cho NT20,NT21,XS20,...
    Next
    For i = 1 To UBound(rng)
        id = rng(i, 7) & "|" & rng(i, 14) & "|" & rng(i, 27) & "|" & rng(i, 26) ' tao chuoi id khac biet, vd: "02/01/2020|Nhap kho NVL|A45|NT"
        If Not dic.exists(id) Then ' neu chuoi nay xuat hien lan dau thi lay item cua NT20 (key)  = item + 1
            dic2(rng(i, 26) & Right(rng(i, 7), 2)) = dic2(rng(i, 26) & Right(rng(i, 7), 2)) + 1
            dic.Add id, dic2(rng(i, 26) & Right(rng(i, 7), 2))
        End If
        res(i, 1) = res(i, 1) & Format(dic(id), "00000") ' noi chuoi co san "20JLPNT" voi so dem moi, format 5 so
    Next
    .Range("A10:A100000").ClearContents
    .Range("A10").Resize(UBound(res), 1).value = res ' dan mang ket qua res vao sheet, tu o A10
End With
End Sub

Cảm ơn sư phụ, để em đọc hiểu và chạy thử ạ. những gì sư phụ bảo em học em vẫn nhớ

bebo021999 · 17/3/23

satoshi99 đã viết:
Cảm ơn sư phụ, để em đọc hiểu và chạy thử ạ. những gì sư phụ bảo em học em vẫn nhớ

Mách bạn 1 cách đọc, hiểu code:
Đôi khi, bạn cần dán kết quả của array, hoặc dictionary ra sheet để xem thành phần của nó 1 cách trực quan:
VD bạn có mảng "res" và dictionary tên là "dic"
Muốn xem các giá trị của mảng res tại cột X và các keys, items của dic tai cột Y và Z:
Bạn thêm dòng này:

PHP:

Range("X1").resize(Ubound(res),Ubound(res,2)).value = res
Range("Y1").resize(dic.count,2).value = WorksheeFunction.Transpose(Array(dic.Keys, dic.Items))

HieuCD · 17/3/23

satoshi99 đã viết:
Thưa anh chị

Em có ý tưởng muốn tạo số phiếu tự động với điều kiện cần thiết, nếu năm đánh số phiếu khác năm trước thì sẽ đánh lại số phiếu từ đầu
E có sử dụng công thức excel nhưng làm với số lượng dòng trên 10.000 thì chạy rất lâu và file bị đơ
Em có viết code bằng vba nhưng do trình độ còn non, code cũng không được nhanh hơn là mấy
Em gửi file lên mong anh chị xem qua và chỉ dạy cho em với ạ! code e viết ở Module 2 ạ

Dữ liệu đã được xếp thứ tự

Mã:

Sub ABC()
  Dim arr(), res(), stt&(), sRow&, i&, j&, key$, tKey$, nam&, tNam&, yy$
  Const GhiChu$ = "NT,XG,XS"
 
  With Sheets("Nhapxuat")
    arr = .Range("G10", .Range("AA" & Rows.Count).End(xlUp)).value
  End With
  sRow = UBound(arr)
  ReDim res(1 To sRow, 1 To 1)
  For i = 1 To sRow
    tNam = Year(arr(i, 1))
    If nam <> tNam Then
      ReDim stt(1 To 7)
      nam = tNam
      yy = Mid(nam, 3, 2)
    End If
    tKey = arr(i, 1) & "|" & arr(i, 8) & "|" & arr(i, 21)
    If key = tKey Then
      res(i, 1) = res(i - 1, 1)
    Else
      key = tKey
      j = InStr(1, GhiChu, arr(i, 20))
      stt(j) = stt(j) + 1
      res(i, 1) = yy & "JLP" & arr(i, 20) & Format(stt(j), "00000")
    End If
  Next i
  Sheets("Nhapxuat").Range("A10").Resize(sRow) = res
End Sub

Nhật Anh 9x · 17/3/23

bebo021999 đã viết:
Mách bạn 1 cách đọc, hiểu code:
Đôi khi, bạn cần dán kết quả của array, hoặc dictionary ra sheet để xem thành phần của nó 1 cách trực quan:
VD bạn có mảng "res" và dictionary tên là "dic"
Muốn xem các giá trị của mảng res tại cột X và các keys, items của dic tai cột Y và Z:
Bạn thêm dòng này:

PHP:

Range("X1").resize(Ubound(res),Ubound(res,2)).value = res Range("Y1").resize(dic.count,2).value = WorksheeFunction.Transpose(Array(dic.Keys, dic.Items))

Vâng, em cảm ơn nhé!

Nhật Anh 9x · 17/3/23

bebo021999 đã viết:
Mách bạn 1 cách đọc, hiểu code:
Đôi khi, bạn cần dán kết quả của array, hoặc dictionary ra sheet để xem thành phần của nó 1 cách trực quan:
VD bạn có mảng "res" và dictionary tên là "dic"
Muốn xem các giá trị của mảng res tại cột X và các keys, items của dic tai cột Y và Z:
Bạn thêm dòng này:

PHP:

Range("X1").resize(Ubound(res),Ubound(res,2)).value = res Range("Y1").resize(dic.count,2).value = WorksheeFunction.Transpose(Array(dic.Keys, dic.Items))

dòng code
.Range("Y1").resize(dic.count,2).value = WorksheeFunction.Transpose(Array(dic.Keys, dic.Items))
em chạy báo lỗi 483 anh ạ!

SA_DQ · 18/3/23

Mình rút ngắn độ dài số chứng từ xuống còn 10, nhưng vẫn đưa vô 3 ký tự biểu thị Năm-Tháng-Ngày
Chủ bài đăng có thể tham khảo thêm

SA_DQ · 20/3/23

Từ bài đầu đến này, chủ bài đăng đang yêu cầu là qua năm mới 3 loại số phiếu tua lại từ đầu;
& kèm theo đó là đã dành đến con số hàng vạn để biểu thị chứng từ tăng dần trong 1 năm;
Nếu ta đưa ra vấn đề là sau từng tháng ta tua lại 3 loại số chứng từ thì sẽ là sao, nhỉ?
Lúc đó tất nhiên ta chỉ cần 4 con số để biểu diễn các chứng từ thay theo tháng mà thôi.
Các bạn nghỉ sao?

Tạo số phiếu tự động

Nhật Anh 9x

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

File đính kèm

BuiQuangThuan

❆❆❆❆❆❆❆❆❆❆❆❆

SA_DQ

/(hông là gì!

Nhật Anh 9x

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

bebo021999

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

File đính kèm

Nhật Anh 9x

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

bebo021999

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

HieuCD

Chuyên gia GPE

Nhật Anh 9x

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

Nhật Anh 9x

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

SA_DQ

/(hông là gì!

File đính kèm

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