TRỢ GIÚP CODE VBA FILE EXCEL

Liên hệ QC

Nguyenthekiet1992

Thành viên mới
Tham gia
3/8/19
Bài viết
4
Được thích
0
Xin chào các tất cả Anh/ Chị/ Em diễn đàn Giải pháp Excel, em là thành viên mới tham gia diễn đàn, em có một vấn đề cần các Anh chị hỗ trợ.
- Đây cũng là 1 câu hỏi các Anh Chị gặp khá nhiều. Trường hợp hiện tại của em đang có 1 file excel sử dụng code VBA để nhập liệu copy từ sheet này sang 1 sheet khác.
- Cụ thể e đã làm được nút bấm"LƯU ĐƠN HÀNG" từ Sheet "BBKN" sang sheet "DSKH_SAVE".
- Tuy nhiên khi cần xuất hàng sheet "BBKN" có 10 dòng chỉ lưu được 1 dòng đầu tiên thôi. Xin các ACE hỗ trợ và chia sẻ giúp em code để hoàn thiện file này, em cũng không rành về code VBA chỉ tập tành làm được như file trên.
- Nếu có thể xin các Anh/Chị hướng dẫn giúp em phần listbox cho nút Button "NHẬP THÔNG TIN" mục "Tên KH" để lấy danh sách từ sheet"DSKH_2019" trên form giao diện. Em làm hoài mà chưa được phần này, không biết file này có lỗi hay là không, em xin cám ơn các Anh/Chị.
 

File đính kèm

  • BIEN BAN GIAO NHAN HANG_CODE_VBA_2019.xlsm
    192.4 KB · Đọc: 12
Lần chỉnh sửa cuối:
Các Anh/ Chị trong diễn đàn biết cái này giúp em với.
 
Lần chỉnh sửa cuối:
Upvote 0
Xin chào các ACE diễn đàn Giải pháp Excel,
Các Anh/ Chị forum nào biết giúp em với.
Bạn mới tham gia diễn đàn, nên viết rõ ràng đúng chính tả, thuần Việt.
Nhiều người không đọc được mấy từ viết tắt như "ACE"...
Tôi chỉ giúp được bạn cho cái nút Lưu Đơn Hàng, còn chuyện khác sẽ có người khác giúp bạn nếu bạn sửa lại nội dung các bài viết của bạn như tôi đã nhắc.
PHP:
Option Explicit

Public Sub LuuDonHang()
Dim Rws As Long, NgayDonHang As Long, SoLuong, DonGia, ThanhTien As Long
Dim sArr(), dArr(), I As Long, J As Long, K As Long, R As Long, SoCT As Long
Dim TenKH As String, DiachiKH As String, NguoiNhan As String
Dim DiachiGiao As String, Sdt As String, MaHang As String, Dvt As String, Ghichu As String
With Sheets("BBKN")
    Rws = .Range("B25").End(xlUp).Row               'Xac dinh dong cuoi cot B'
    If Rws < 13 Then                                'Neu so dong cuoi < 13 thi Thong bao, Thoat'
        MsgBox "Khong co Hang xuat!", , "GPE"
        Exit Sub
    End If
    NgayDonHang = .Range("E6").Value                'Gan cac thong tin chung'
    SoCT = .Range("G6").Value
    TenKH = .Range("C7").Value
    DiachiKH = .Range("C8").Value
    NguoiNhan = .Range("C9").Value
    Sdt = .Range("F9").Value
    DiachiGiao = .Range("C10").Value
    sArr = .Range("B13:B" & Rws).Resize(, 6).Value  'Mang hang hoa xuat'
    .Range("G6") = SoCT + 1                         'SoCT tang them 1'
    .Range("C7,C9:C10,F9,B10:E22").ClearContents    'Xoa du lieu'
End With
R = UBound(sArr)
ReDim dArr(1 To R, 1 To 15)
For I = 1 To R                                      'Gan tat ca du lieu vao mang dArr'
    K = K + 1
    dArr(K, 1) = SoCT
    dArr(K, 2) = NgayDonHang
    dArr(K, 3) = TenKH
    dArr(K, 4) = DiachiKH
        For J = 1 To 6
            dArr(K, J + 4) = sArr(I, J)
        Next J
    dArr(K, 11) = NguoiNhan
    dArr(K, 12) = Sdt
    dArr(K, 13) = DiachiGiao
Next I
'-----------------------Gan mang dArr xuong sheet DSKH_SAVE'
Sheets("DSKH_SAVE").Range("A100000").End(xlUp).Offset(1).Resize(K, 13) = dArr
MsgBox "Da Luu Xong.", , "GPE"
End Sub
 
Lần chỉnh sửa cuối:
Upvote 0
Bạn mới tham gia diễn đàn, nên viết rõ ràng đúng chính tả, thuần Việt.
Nhiều người không đọc được mấy từ viết tắt như "ACE"...
Tôi chỉ giúp được bạn cho cái nút Lưu Đơn Hàng, còn chuyện khác sẽ có người khác giúp bạn nếu bạn sửa lại nội dung các bài viết của bạn như tôi đã nhắc.
PHP:
Option Explicit

Public Sub LuuDonHang()
Dim Rws As Long, NgayDonHang As Long, SoLuong, DonGia, ThanhTien As Long
Dim sArr(), dArr(), I As Long, J As Long, K As Long, R As Long, SoCT As Long
Dim TenKH As String, DiachiKH As String, NguoiNhan As String
Dim DiachiGiao As String, Sdt As String, MaHang As String, Dvt As String, Ghichu As String
With Sheets("BBKN")
    Rws = .Range("B25").End(xlUp).Row               'Xac dinh dong cuoi cot B'
    If Rws < 13 Then                                'Neu so dong cuoi < 13 thi Thong bao, Thoat'
        MsgBox "Khong co Hang xuat!", , "GPE"
        Exit Sub
    End If
    NgayDonHang = .Range("E6").Value                'Gan cac thong tin chung'
    SoCT = .Range("G6").Value
    TenKH = .Range("C7").Value
    DiachiKH = .Range("C8").Value
    NguoiNhan = .Range("C9").Value
    Sdt = .Range("F9").Value
    DiachiGiao = .Range("C10").Value
    sArr = .Range("B13:B" & Rws).Resize(, 6).Value  'Mang hang hoa xuat'
    .Range("G6") = SoCT + 1                         'SoCT tang them 1'
    .Range("C7,C9:C10,F9,B10:E22").ClearContents    'Xoa du lieu'
End With
R = UBound(sArr)
ReDim dArr(1 To R, 1 To 15)
For I = 1 To R                                      'Gan tat ca du lieu vao mang dArr'
    K = K + 1
    dArr(K, 1) = SoCT
    dArr(K, 2) = NgayDonHang
    dArr(K, 3) = TenKH
    dArr(K, 4) = DiachiKH
        For J = 1 To 6
            dArr(K, J + 4) = sArr(I, J)
        Next J
    dArr(K, 11) = NguoiNhan
    dArr(K, 12) = Sdt
    dArr(K, 13) = DiachiGiao
Next I
'-----------------------Gan mang dArr xuong sheet DSKH_SAVE'
Sheets("DSKH_SAVE").Range("A100000").End(xlUp).Offset(1).Resize(K, 13) = dArr
MsgBox "Da Luu Xong.", , "GPE"
End Sub

Cám ơn anh đã chia sẽ những thiếu xót trong bài viết của em. Mong anh thông cảm vì em là cũng là thành viên mới của diễn đàn Giải Pháp Excel.
Em xin được rút kinh nghiệm đề lần sau trau chuốt hơn về câu từ ngữ. Nói thì nói mà thương thì thương phải không anh? Vốn dĩ diễn đàn là một đại gia đình mà.
Đoạn code anh sửa lại mới thấy a thật sự là một người có tâm và có tầm, vậy mới thấy được code em viết thật sự sơ sài, cám ơn anh đã chỉnh lại cho em. Nó là một bài chỉnh sửa rất bổ ích và quý giá, ghi từng đoạn code và diễn giải dùng để làm gì. Một lần nữa e xin chân thành cảm ơn người Anh.
 
Lần chỉnh sửa cuối:
Upvote 0
Web KT
Back
Top Bottom