code VBA bị lỗi trích xuất dữ liệu để in phiếu xuất kho

Liên hệ QC

dinhduy

Thành viên hoạt động
Tham gia
24/11/07
Bài viết
167
Được thích
76
Em chào mọi người, em mới tập hợp với CODE VBA, rất mong được mọi người hỗ trợ ah.
Cụ thể là sau: Tôi nhập dữ liệu bên trong Sheet XUAT, sau đó quá mình qua Sheet XKQB để in phiếu

- Khi chọn SỐ PHIẾU và Click lấy thông tin bên Sheet XUAT để điền vào từng cột tương ứng để IN phiếu
(Em có để ví dụ trong File, lấy thông tin từ các cột nào và em điền mẫu 1 phiếu ah - ô tô màu vàng).
Em CODE tập tin nhưng không được chạy, rất mong được sự giúp đỡ của mọi người.
Em xin chân thành cảm ơn!

Lưu ý: Phiếu IN giới hạn chỉ có tối đa 7 dòng mặt hàng thôi, Sheet XUAT khi nhập vào sẽ tự giới hạn ah.
 

File đính kèm

  • Test.xlsb
    141.8 KB · Đọc: 15
Em chào mọi người, em mới tập hợp với CODE VBA, rất mong được mọi người hỗ trợ ah.
Cụ thể là sau: Tôi nhập dữ liệu bên trong Sheet XUAT, sau đó quá mình qua Sheet XKQB để in phiếu

- Khi chọn SỐ PHIẾU và Click lấy thông tin bên Sheet XUAT để điền vào từng cột tương ứng để IN phiếu
(Em có để ví dụ trong File, lấy thông tin từ các cột nào và em điền mẫu 1 phiếu ah - ô tô màu vàng).
Em CODE tập tin nhưng không được chạy, rất mong được sự giúp đỡ của mọi người.
Em xin chân thành cảm ơn!

Lưu ý: Phiếu IN giới hạn chỉ có tối đa 7 dòng mặt hàng thôi, Sheet XUAT khi nhập vào sẽ tự giới hạn ah.
Tự kiểm tra nhé.
Mã:
Sub TimPhieu()
    Dim ArrN(), ArrD(), Fm
    Dim i  As Long, k As Long, Dcuoi As Long

Application.Calculation = xlCalculationManual
Application.ScreenUpdating = False
    Set Fm = Application.WorksheetFunction
    With Sheet04
    .[E8] = Fm.VLookup(.[T2], [XK], 4, 0)
    .[P8] = Fm.VLookup(.[T2], [XK], 2, 0)
    .[S8] = Fm.VLookup(.[T2], [XK], 2, 0)
    .[U8] = Fm.VLookup(.[T2], [XK], 2, 0)
    .[C10] = Fm.VLookup(.[T2], [XK], 5, 0)
    .[l19] = Fm.VLookup(.[T2], [XK], 13, 0)
    End With
Dcuoi = Sheet03.Range("B1000000").End(xlUp).Row
ArrN = Sheet03.Range("B3:O" & Dcuoi).Value
Phieu = Sheet04.Range("T2")
ReDim ArrD(1 To UBound(ArrN, 1), 1 To 15)
For i = 1 To UBound(ArrN, 1)
    If ArrN(i, 3) <> "" And ArrN(i, 2) = Phieu Then
        k = k + 1
        ArrD(k, 1) = k
        ArrD(k, 2) = ArrN(i, 8)
        ArrD(k, 9) = ArrN(i, 9)
        ArrD(k, 11) = ArrN(i, 11)
        ArrD(k, 13) = ArrN(i, 12)
        ArrD(k, 15) = ArrN(i, 10)
    End If
Next
If k = 0 Then
    MsgBox "Chua co phat sinh"
    Exit Sub
Else
    With Sheet04
        .Range("B11:U17").ClearContents
        .Range("B11").Resize(k, 15) = ArrD
    End With
End If
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
End Sub
 
Upvote 0
(1) Bạn khai báo ReDim ArrD(1 To UBound(ArrN, 1), 1 To 7)
Là đang dư số hàng rất nhiều & không cần thiết; Bạn khẳng định chỉ 7 dòng hàng hóa thôi, nên mảng này chỉ 7 dòng
Số cột 7 là đang thiếu to:
Trị đơn giá phải được ấn vô cột [N] & [Ghi chú] phải gán vô cột [P]; Đó là chưa kể trong macro bạn còn phải ghi [Số kiện] lên cột (là cột thứ 21 của trang tính.
Nên bạn phải khai báo lại: ReDim ArrD(1 To 7, 1 To 21)
 
Upvote 0
(1) Bạn khai báo ReDim ArrD(1 To UBound(ArrN, 1), 1 To 7)
Là đang dư số hàng rất nhiều & không cần thiết; Bạn khẳng định chỉ 7 dòng hàng hóa thôi, nên mảng này chỉ 7 dòng
Số cột 7 là đang thiếu to:
Trị đơn giá phải được ấn vô cột [N] & [Ghi chú] phải gán vô cột [P]; Đó là chưa kể trong macro bạn còn phải ghi [Số kiện] lên cột (là cột thứ 21 của trang tính.
Nên bạn phải khai báo lại: ReDim ArrD(1 To 7, 1 To 21)
Cột ghi chú thực tế là chỉ để ghi mã hàng hóa (hàng hóa để làm gì) của khách hàng gửi trong đơn, bắt buộc mình phải ghi vào đó ah.
Có 1 vài trường hợp đặc biệt xíu (khách lẻ), tận dụng cột ghi chú đó làm THÀNH TIỀN luôn.
Có 7 dòng là vì khổ giấy in là A5 nên chỉ có như vậy ah, nếu dòng nhiều qua sẽ cho qua phiếu tiếp theo.
Em học lỏm trên mạng, cố gắng tìm hiểu được đến đó, nên rất mong anh và mọi người chỉ thêm.
Em cám ơn !
Bài đã được tự động gộp:

Tự kiểm tra nhé.
Mã:
Sub TimPhieu()
    Dim ArrN(), ArrD(), Fm
    Dim i  As Long, k As Long, Dcuoi As Long

Application.Calculation = xlCalculationManual
Application.ScreenUpdating = False
    Set Fm = Application.WorksheetFunction
    With Sheet04
    .[E8] = Fm.VLookup(.[T2], [XK], 4, 0)
    .[P8] = Fm.VLookup(.[T2], [XK], 2, 0)
    .[S8] = Fm.VLookup(.[T2], [XK], 2, 0)
    .[U8] = Fm.VLookup(.[T2], [XK], 2, 0)
    .[C10] = Fm.VLookup(.[T2], [XK], 5, 0)
    .[l19] = Fm.VLookup(.[T2], [XK], 13, 0)
    End With
Dcuoi = Sheet03.Range("B1000000").End(xlUp).Row
ArrN = Sheet03.Range("B3:O" & Dcuoi).Value
Phieu = Sheet04.Range("T2")
ReDim ArrD(1 To UBound(ArrN, 1), 1 To 15)
For i = 1 To UBound(ArrN, 1)
    If ArrN(i, 3) <> "" And ArrN(i, 2) = Phieu Then
        k = k + 1
        ArrD(k, 1) = k
        ArrD(k, 2) = ArrN(i, 8)
        ArrD(k, 9) = ArrN(i, 9)
        ArrD(k, 11) = ArrN(i, 11)
        ArrD(k, 13) = ArrN(i, 12)
        ArrD(k, 15) = ArrN(i, 10)
    End If
Next
If k = 0 Then
    MsgBox "Chua co phat sinh"
    Exit Sub
Else
    With Sheet04
        .Range("B11:U17").ClearContents
        .Range("B11").Resize(k, 15) = ArrD
    End With
End If
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
End Sub
Em cám ơn anh rất nhiều ah!
Bị thiếu cột mã kiện nhưng em biết cách chỉnh sửa thêm vào rồi ah.
Anh cho em hỏi 1 cái nữa, khi em chèn đoạn vào trực tiếp trên Sheet XKQB để khi mình thay đổi số phiếu tự chạy luôn thì báo lỗi, có thể nhờ a sửa giúp em chỗ này với.

Mã:
Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.Address = "$T$9" Then
        Call TimPhieu
    End If
End Sub
 
Lần chỉnh sửa cuối:
Upvote 0
Bạn bỏ trộn các cột 1 cách tạm thời trên form 'Phiếu Xuất' sẽ thấy vấn đề & tự sửa được mà!
 
Upvote 0
Tham khảo bài #2 & tự làm tiếp đi bạn;
Gợi ý nè:
Sang trang có form phiếu xuất;
Nhấn chuột vô các ô có dữ liệu thuộc dòng 9;
Lấy bút ghi lại địa chỉ cột có ghi trên góc trái trên của Excel, ta sẽ thấy lần lượt các địa chỉ B9; C9; J9; L9; N9; P9 & U11
2ui đổ các kí tự biểu thị cột này thành số, ví dụ B => 2; C => 3,. . . .
Các số này sẽ phải xuất hiện tương ứng trong các lệnh sau:
PHP:
       ArrD(k, 1) = k              'STT    '
       ArrD(k, 2) = ArrN(i, 8)     'Tên HH   '
        ArrD(k, 3) = ArrN(i, 9)     'DVT    '
        ArrD(k, 4) = ArrN(i, 11)    'So Lg  '
        ArrD(k, 5) = ArrN(i, 12)    'D Gia  '
        ArrD(k, 6) = ArrN(i, 10)    'Ghi Chú    '
        ArrD(k, 7) = ArrN(i, 13)    'Kiên   '
Thay vì 1 đến 7 như trong lệnh
& chúc bạn thành công & có niềm vui với nó!

[Thêm]: Câu lệnh dưới đây chưa chuẩn & bạn cần sửa lại .Range("C11").Resize(k, 7).Value = ArrD ' '
 
Lần chỉnh sửa cuối:
Upvote 0
Tham khảo bài #2 & tự làm tiếp đi bạn;
Gợi ý nè:
Sang trang có form phiếu xuất;
Nhấn chuột vô các ô có dữ liệu thuộc dòng 9;
Lấy bút ghi lại địa chỉ cột có ghi trên góc trái trên của Excel, ta sẽ thấy lần lượt các địa chỉ B9; C9; J9; L9; N9; P9 & U11
2ui đổ các kí tự biểu thị cột này thành số, ví dụ B => 2; C => 3,. . . .
Các số này sẽ phải xuất hiện tương ứng trong các lệnh sau:
PHP:
       ArrD(k, 1) = k              'STT    '
       ArrD(k, 2) = ArrN(i, 8)     'Tên HH   '
        ArrD(k, 3) = ArrN(i, 9)     'DVT    '
        ArrD(k, 4) = ArrN(i, 11)    'So Lg  '
        ArrD(k, 5) = ArrN(i, 12)    'D Gia  '
        ArrD(k, 6) = ArrN(i, 10)    'Ghi Chú    '
        ArrD(k, 7) = ArrN(i, 13)    'Kiên   '
Thay vì 1 đến 7 như trong lệnh
& chúc bạn thành công & có niềm vui với nó!

[Thêm]: Câu lệnh dưới đây chưa chuẩn & bạn cần sửa lại .Range("C11").Resize(k, 7).Value = ArrD ' '
Anh nói chỗ này thì em hiểu nhưng khi gán code để chạy trực tiếp khi thay đổi số phiếu thì báo lỗi ở chỗ Sub TimPhieu
Nhưng nếu mình tạo nút nhấn thì kết quả ok. Nhờ a giải thích chút xíu cho hiểu với ah. Em cám ơn rất nhiều.
Lần này e học thêm được 1 kinh nghiệm nữa.

Mã:
Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.Address = "$T$2" Then
        Call TimPhieu
    End If
End Sub
 
Upvote 0
Anh nói chỗ này thì em hiểu nhưng khi gán code để chạy trực tiếp khi thay đổi số phiếu thì báo lỗi ở chỗ Sub TimPhieu
Nhưng nếu mình tạo nút nhấn thì kết quả ok. Nhờ a giải thích chút xíu cho hiểu với ah. Em cám ơn rất nhiều.
Lần này e học thêm được 1 kinh nghiệm nữa.

Mã:
Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.Address = "$T$2" Then
        Call TimPhieu
    End If
End Sub
Thử thế này và tự rút nhận xét.
Mã:
Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.Address = "$T$2" Then
         Application.EnableEvents = False
         Call TimPhieu
         Application.EnableEvents = True
    End If
End Sub
[/code
 
Upvote 0
Thử thế này và tự rút nhận xét.
Mã:
Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.Address = "$T$2" Then
         Application.EnableEvents = False
         Call TimPhieu
         Application.EnableEvents = True
    End If
End Sub
[/code
Anh ơi, nhờ anh xem lại giúp em với ah. Khi thay đổi SỐ PHIẾU tự chạy vẫn báo lỗi, còn click để chạy thì không bị lỗi.
Cám ơn anh rất nhiều ah!
 

File đính kèm

  • Bao Loi.png
    Bao Loi.png
    126.8 KB · Đọc: 10
  • Test.xlsb
    141.2 KB · Đọc: 7
Upvote 0
Đưa cái Sub TimPhieu vào trong sheet XKQB luôn, để trong Module nó không chịu.
Em làm được rồi, em cám ơn anh rất nhiều nha !
Tại em thấy người ta làm để Module vẫn chạy bình thường nên làm theo,
nếu được a có thể giải thích giúp em hiểu phần này không ah.
 
Upvote 0
Em làm được rồi, em cám ơn anh rất nhiều nha !
Tại em thấy người ta làm để Module vẫn chạy bình thường nên làm theo,
nếu được a có thể giải thích giúp em hiểu phần này không ah.
Tôi không biết cái sub của bạn thế nào nửa. Nhưng nếu bạn tạo cái Sub mới và copy tất cả code trong cái sub TimPhieu và dán vào cái sub mới tạo sau đó trong sub Worksheet_Change bạn gọi cái sub mới thoải mái chạy vèo vèo.
 
Upvote 0
Web KT

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

Back
Top Bottom