Giúp copy dữ liệu vào file mẫu

Liên hệ QC
C

cubinv

Thành viên mới
Tham gia
23/4/22
Bài viết
37
Được thích
10
Xin chào các Anh Chị và các Bạn,
Hộm trước mình đã được các Bạn giúp đỡ viết code tổng hợp vật tư cho từng sản phẩm rất hiệu quả cho công việc của mình. Hôm nay mình lại nhờ các Bạn giúp mình viết giúp code copy dữ liệu vào file mẫu, nội dung cụ thể mình diễn giải theo file đính kèm. Rất mong các Bạn giúp, cảm ơn mọi người rất nhiều!
 

File đính kèm

  • file_demo.xlsm
    18.9 KB · Đọc: 17
Sắp xếp theo thời gian sắp xếp theo bầu chọn
cubinv đã viết:
Xin chào các Anh Chị và các Bạn,
Hộm trước mình đã được các Bạn giúp đỡ viết code tổng hợp vật tư cho từng sản phẩm rất hiệu quả cho công việc của mình. Hôm nay mình lại nhờ các Bạn giúp mình viết giúp code copy dữ liệu vào file mẫu, nội dung cụ thể mình diễn giải theo file đính kèm. Rất mong các Bạn giúp, cảm ơn mọi người rất nhiều!
Nhấp chuột vào đây để mở rộng...
Khách hàng có 2 hợp đồng kết quả như thế nào?
 
Lần chỉnh sửa cuối:
Upvote 0
cubinv đã viết:
Mình đọc không kỹ, bên mình mỗi khách hàng chỉ có 1 hợp đồng thôi ạ.
Nhấp chuột vào đây để mở rộng...
Bạn cũng nên viết rõ. Tôi nhìn lướt qua thì thấy dữ liệu đã được sắp xếp (số chứng từ). Đó là sự ngẫu nhiên trong tập tin này hay luôn là thế? Bởi viết code cho dữ liệu đã được sắp xếp và dữ liệu "hỗn loạn" có thể khác nhau. Ở GPE này người ta thách đố nhau không dùng đít thon, không dùng nhiều FOR, code ít chữ, chạy nhanh hơn phần nghìn giây. Tóm lại quan trọng với bạn là code để giải quyết công việc, khá dễ hiểu, hay code để đi thi thố. Code chạy nhanh hơn chút, dùng để thi thố chưa chắc đã dễ hiểu hơn với bạn.
 
Upvote 0
cubinv đã viết:
Mình đọc không kỹ, bên mình mỗi khách hàng chỉ có 1 hợp đồng thôi ạ.
Nhấp chuột vào đây để mở rộng...
Chỉnh lại sheet file_mau, copy sheet nầy cho file thực tế
Tự chỉnh các dòng lệnh mình ghi chú trong code
Mã: 
Sub XYZ()
  Dim aKH(), aNhap(), wb As Workbook, path$
  Dim srKH&, sRow&, i&, r&, k&
  Dim kh$, soCT$, ngayCT As Date
  
  On Error GoTo Thoat
  path = ThisWorkbook.path 'Duong dan luu file moi tao
  With Sheets("data_khach")
    i = .Range("B1000000").End(xlUp).Row
    If i < 6 Then MsgBox ("Khong co du lieu Khach Hang!"): Exit Sub
    aKH = .Range("B6:F" & i).Value
  End With
  srKH = UBound(aKH)
  With Sheets("data_nhap")
    i = .Range("C1000000").End(xlUp).Row
    If i < 7 Then MsgBox ("Khong co du lieu Vat Tu!"): Exit Sub
    aNhap = .Range("C7:K" & i + 1).Value
  End With
  sRow = UBound(aNhap)
  Sheets("file_mau").Copy
  Application.DisplayAlerts = False
  Application.ScreenUpdating = False
  ActiveWorkbook.SaveAs Filename:=path & "\kq_kiem_tra.xlsx"
  Set wb = ActiveWorkbook
  For i = 1 To srKH
    ReDim res(1 To sRow, 1 To 9)
    k = 0
    kh = aKH(i, 1)
    For r = 1 To sRow
      If aNhap(r, 9) = kh Then
        k = k + 1
        res(k, 1) = k
        res(k, 2) = aNhap(r, 1)
        res(k, 5) = aNhap(r, 2)
        res(k, 6) = aNhap(r, 3)
        res(k, 7) = res(k, 6)
        res(k, 8) = 0
        If k = 1 Then
          ngayCT = aNhap(r, 7) 'Ngay chung tu
          soCT = aNhap(r, 8) 'So chung tu
        End If
      ElseIf k > 0 Then
        wb.Sheets("file_mau").Copy after:=wb.Sheets(Sheets.Count)
        With wb.Sheets(Sheets.Count)
          .Name = soCT
          .Range("D3").Value = ngayCT
          .Range("A8").Value = Replace(Replace(Replace(Replace(.Range("A8").Value, "#HD#", aKH(i, 3)), _
              "#Ngay#", Format(aKH(i, 4), "dd/mm/yyyy")), "#KH#", aKH(i, 2)), "#SP#", aKH(i, 5))
          .Range("A19:I22").ClearContents
          If k > 4 Then
            .Range("A20").Resize(k - 4).EntireRow.Insert , CopyOrigin:=xlFormatFromLeftOrAbove
          ElseIf k < 4 Then
            .Range("A19").Resize(4 - k).EntireRow.Delete
          End If
          .Range("A19").Resize(k, 9) = res
        End With
        Exit For
      End If
    Next r
  Next i
  wb.Sheets("file_mau").Delete 'Xóa sheet trung gian "file_mau"
  wb.Save
  'wb.Close 'Dong file kq_kiem_tra.xlsx
Thoat:
  If Err.Number > 0 Then MsgBox ("Dong file kq_kiem_tra.xlsx truoc khi chay code")
  Application.ScreenUpdating = True
  Application.DisplayAlerts = True
  Set wb = Nothing
End Sub
 

File đính kèm

  • file_demo.xlsm
    36 KB · Đọc: 16
Lần chỉnh sửa cuối:
Upvote 0
batman1 đã viết:
Bạn cũng nên viết rõ. Tôi nhìn lướt qua thì thấy dữ liệu đã được sắp xếp (số chứng từ). Đó là sự ngẫu nhiên trong tập tin này hay luôn là thế? Bởi viết code cho dữ liệu đã được sắp xếp và dữ liệu "hỗn loạn" có thể khác nhau. Ở GPE này người ta thách đố nhau không dùng đít thon, không dùng nhiều FOR, code ít chữ, chạy nhanh hơn phần nghìn giây. Tóm lại quan trọng với bạn là code để giải quyết công việc, khá dễ hiểu, hay code để đi thi thố. Code chạy nhanh hơn chút, dùng để thi thố chưa chắc đã dễ hiểu hơn với bạn.
Nhấp chuột vào đây để mở rộng...
Cảm ơn Bạn đã góp ý, mình nhờ các Bạn giúp để cải thiện hiệu suất làm việc thôi, không có ý nào khác. Khi đưa ra yêu cầu có những vấn đề mình không lường hết được nên diễn giải không đầy đủ, mong các Bạn thông cảm.
 
Upvote 0
HieuCD đã viết:
Chỉnh lại sheet file_mau, copy sheet nầy cho file thực tế
Tự chỉnh các dòng lệnh mình ghi chú trong code
Nhấp chuột vào đây để mở rộng...
Thành thật xin lỗi Bạn @HieuCD sáng nay mình chưa kiểm tra kỹ code Bạn gửi. Sau khi đưa dữ liệu vào mình thấy còn những vướng mắc sau nhờ Bạn sửa lại:
- Code đã dồn 2 chứng từ của cùng 1 nhà cung cấp vào 1 biên bản nếu số chứng từ liên tiếp nhau, ví dụ chứng từ số 2 và số 3 của cùng 1 nhà cung cấp KH002 khi chạy code sẽ đưa chung vào 1 biên bản số 2 --> Bạn sửa giúp thành 2 biên bản khác nhau giúp mình.
- Trường hợp code đã tìm thấy chứng từ thứ nhất và copy thành biên bản thứ nhất, khi phát sinh chứng từ thứ hai (khác ngày và không liền kề với dòng của chứng từ thứ nhất) thì chứng từ thứ 2 đó bị bỏ qua không có biên bản.
- Nhờ Bạn bổ sung thêm cảnh báo không tìm thấy mã nhà cung cấp trong trường hợp không tìm thấy mã nhà cung cấp tương ứng trong sheet "data_khach" và sắp xếp số biên bản từ thấp đến cao trong sheet "kq_kiem_tra" sau khi đã chạy xong code.

Mình gửi lại file đã bổ sung dữ liệu mà khi chạy code xảy ra các lỗi trên, rất mong Bạn hoàn thiện giúp mình, cảm ơn Bạn rất nhiều!
 

File đính kèm

  • file_demo_con loi.xlsm
    35.7 KB · Đọc: 4
Upvote 0
cubinv đã viết:
Thành thật xin lỗi Bạn @HieuCD sáng nay mình chưa kiểm tra kỹ code Bạn gửi. Sau khi đưa dữ liệu vào mình thấy còn những vướng mắc sau nhờ Bạn sửa lại:
- Code đã dồn 2 chứng từ của cùng 1 nhà cung cấp vào 1 biên bản nếu số chứng từ liên tiếp nhau, ví dụ chứng từ số 2 và số 3 của cùng 1 nhà cung cấp KH002 khi chạy code sẽ đưa chung vào 1 biên bản số 2 --> Bạn sửa giúp thành 2 biên bản khác nhau giúp mình.
- Trường hợp code đã tìm thấy chứng từ thứ nhất và copy thành biên bản thứ nhất, khi phát sinh chứng từ thứ hai (khác ngày và không liền kề với dòng của chứng từ thứ nhất) thì chứng từ thứ 2 đó bị bỏ qua không có biên bản.
- Nhờ Bạn bổ sung thêm cảnh báo không tìm thấy mã nhà cung cấp trong trường hợp không tìm thấy mã nhà cung cấp tương ứng trong sheet "data_khach" và sắp xếp số biên bản từ thấp đến cao trong sheet "kq_kiem_tra" sau khi đã chạy xong code.

Mình gửi lại file đã bổ sung dữ liệu mà khi chạy code xảy ra các lỗi trên, rất mong Bạn hoàn thiện giúp mình, cảm ơn Bạn rất nhiều!
Nhấp chuột vào đây để mở rộng...
Cột ngày chứng từ sai, 1 chứng từ có nhiều ngày, số chứng từ phải đánh theo thứ tự thời gian phát sinh, những chứng từ không tìm thấy khách hàng sẽ không tạo biên bản
Sheet file_mau ô D3 format thiếu năm
Đã chỉnh các lỗi trong sheet
Chạy code mới
Mã: 
Option Explicit
Sub XYZ()
  Dim aKH(), aNhap(), res(), wb As Workbook, path$, dic As Object
  Dim sRow&, i&, r&, k&, ik&
  Dim kh$, soCT$, ngayCT As Date
 
  On Error GoTo Thoat
  Set dic = CreateObject("scripting.dictionary")
  With Sheets("data_khach")
    i = .Range("B1000000").End(xlUp).Row
    If i < 6 Then MsgBox ("Khong co du lieu Khach Hang!"): Exit Sub
    aKH = .Range("B6:F" & i).Value
  End With
  For i = 1 To UBound(aKH)
    dic.Item(aKH(i, 1)) = i
  Next i
  Application.ScreenUpdating = False
  With Sheets("data_nhap")
    i = .Range("C1000000").End(xlUp).Row
    If i < 7 Then
      Application.ScreenUpdating = True
      MsgBox ("Khong co du lieu Vat Tu!"): Exit Sub
    End If
    res = .Range("A7:K" & i).Value
    .Range("A7:K" & i).Sort .Range("I7"), 1, .Range("J7"), , 1, Header:=xlNo
    aNhap = .Range("C7:L" & i + 1).Value
    .Range("A7:K" & i).Value = res
  End With
  sRow = UBound(aNhap) - 1
 
  Sheets("file_mau").Copy
  Application.DisplayAlerts = False
  path = ThisWorkbook.path 'Duong dan luu file moi tao
  ActiveWorkbook.SaveAs Filename:=path & "\kq_kiem_tra.xlsx"
  Set wb = ActiveWorkbook
 
  For i = 1 To sRow
    If soCT <> aNhap(i, 8) Then
      If dic.exists(aNhap(i, 9)) Then
        k = 0
        ik = dic.Item(aNhap(i, 9))
        ngayCT = aNhap(i, 7) 'Ngay chung tu
        soCT = aNhap(i, 8) 'So chung tu
      Else
        ik = 0
        MsgBox ("So chung tu: " & aNhap(i, 8) & Chr(10) & _
              "Khong tim thay ma Khach hang: " & aNhap(i, 9))
        soCT = aNhap(i, 8)
      End If
    End If
    If ik > 0 Then
      If soCT = aNhap(i, 8) Then
        k = k + 1
        res(k, 1) = k
        res(k, 2) = aNhap(i, 1)
        res(k, 5) = aNhap(i, 2)
        res(k, 6) = aNhap(i, 3)
        res(k, 7) = res(i, 6)
        res(k, 8) = 0
      End If
      If soCT <> aNhap(i + 1, 8) Then
        wb.Sheets("file_mau").Copy after:=wb.Sheets(Sheets.Count)
        With wb.Sheets(Sheets.Count)
          .Name = soCT
          .Range("D3").Value = ngayCT
          .Range("A8").Value = Replace(Replace(Replace(Replace(.Range("A8").Value, "#HD#", aKH(ik, 3)), _
              "#Ngay#", Format(aKH(ik, 4), "dd/mm/yyyy")), "#KH#", aKH(ik, 2)), "#SP#", aKH(ik, 5))
          .Range("A19:I22").ClearContents
          If k > 4 Then
            .Range("A20").Resize(k - 4).EntireRow.Insert , CopyOrigin:=xlFormatFromLeftOrAbove
          ElseIf k < 4 Then
            .Range("A19").Resize(4 - k).EntireRow.Delete
          End If
          .Range("A19").Resize(k, 9) = res
        End With
      End If
    End If
  Next i
  wb.Sheets("file_mau").Delete 'Xóa sheet trung gian "file_mau"
  wb.Save
  'wb.Close 'Dong file kq_kiem_tra.xlsx
Thoat:
  If Err.Number > 0 Then MsgBox ("Dong file kq_kiem_tra.xlsx truoc khi chay code")
  Application.ScreenUpdating = True
  Application.DisplayAlerts = True
  Set wb = Nothing
End Sub
 

File đính kèm

  • file_demo_con loi.xlsm
    40.6 KB · Đọc: 7
Upvote 0
HieuCD đã viết:
Cột ngày chứng từ sai, 1 chứng từ có nhiều ngày, số chứng từ phải đánh theo thứ tự thời gian phát sinh, những chứng từ không tìm thấy khách hàng sẽ không tạo biên bản
Sheet file_mau ô D3 format thiếu năm
Đã chỉnh các lỗi trong sheet
Chạy code mới
Nhấp chuột vào đây để mở rộng...
Cảm ơn Bạn @HieuCD rất nhiều, còn 1 lỗi nhỏ mình sẽ tự tìm hiểu để chỉnh sửa.
 
Lần chỉnh sửa cuối:
Upvote 0
cubinv đã viết:
Cảm ơn Bạn rất nhiều, còn 1 lỗi nhỏ là tên vật tư và đơn vị tính bị copy trùng vào Cột 3 - Mã số và Cột 4 - Hình thức kiểm tra. Mình gửi Ảnh đính kèm, nhờ Bạn chỉnh lại giúp mình.
Nhấp chuột vào đây để mở rộng...
Chỉnh lại tí xíu . .
Mã: 
Option Explicit
Sub XYZ()
  Dim aKH(), aNhap(), res(), wb As Workbook, path$, dic As Object
  Dim sRow&, i&, r&, k&, ik&
  Dim kh$, soCT$, ngayCT As Date
 
  On Error GoTo Thoat
  Set dic = CreateObject("scripting.dictionary")
  With Sheets("data_khach")
    i = .Range("B1000000").End(xlUp).Row
    If i < 6 Then MsgBox ("Khong co du lieu Khach Hang!"): Exit Sub
    aKH = .Range("B6:F" & i).Value
  End With
  For i = 1 To UBound(aKH)
    dic.Item(aKH(i, 1)) = i
  Next i
  Application.ScreenUpdating = False
  With Sheets("data_nhap")
    i = .Range("C1000000").End(xlUp).Row
    If i < 7 Then
      Application.ScreenUpdating = True
      MsgBox ("Khong co du lieu Vat Tu!"): Exit Sub
    End If
    res = .Range("A7:K" & i).Value
    .Range("A7:K" & i).Sort .Range("I7"), 1, .Range("J7"), , 1, Header:=xlNo
    aNhap = .Range("C7:L" & i + 1).Value
    .Range("A7:K" & i).Value = res
  End With
  sRow = UBound(aNhap) - 1
 
  Sheets("file_mau").Copy
  Application.DisplayAlerts = False
  path = ThisWorkbook.path 'Duong dan luu file moi tao
  ActiveWorkbook.SaveAs Filename:=path & "\kq_kiem_tra.xlsx"
  Set wb = ActiveWorkbook
 
  For i = 1 To sRow
    If soCT <> aNhap(i, 8) Then
      If dic.exists(aNhap(i, 9)) Then
        k = 0
        ik = dic.Item(aNhap(i, 9))
        ngayCT = aNhap(i, 7) 'Ngay chung tu
        soCT = aNhap(i, 8) 'So chung tu
      Else
        ik = 0
        MsgBox ("So chung tu: " & aNhap(i, 8) & Chr(10) & _
              "Khong tim thay ma Khach hang: " & aNhap(i, 9))
        soCT = aNhap(i, 8)
      End If
      ReDim res(1 To sRow, 1 To 9)
    End If
    If ik > 0 Then
      If soCT = aNhap(i, 8) Then
        k = k + 1
        res(k, 1) = k
        res(k, 2) = aNhap(i, 1)
        res(k, 5) = aNhap(i, 2)
        res(k, 6) = aNhap(i, 3)
        res(k, 7) = res(k, 6)
        res(k, 8) = 0
      End If
      If soCT <> aNhap(i + 1, 8) Then
        wb.Sheets("file_mau").Copy after:=wb.Sheets(Sheets.Count)
        With wb.Sheets(Sheets.Count)
          .Name = soCT
          .Range("D3").Value = ngayCT
          .Range("A8").Value = Replace(Replace(Replace(Replace(.Range("A8").Value, "#HD#", aKH(ik, 3)), _
              "#Ngay#", Format(aKH(ik, 4), "dd/mm/yyyy")), "#KH#", aKH(ik, 2)), "#SP#", aKH(ik, 5))
          .Range("A19:I22").ClearContents
          If k > 4 Then
            .Range("A20").Resize(k - 4).EntireRow.Insert , CopyOrigin:=xlFormatFromLeftOrAbove
          ElseIf k < 4 Then
            .Range("A19").Resize(4 - k).EntireRow.Delete
          End If
          .Range("A19").Resize(k, 9) = res
        End With
      End If
    End If
  Next i
  wb.Sheets("file_mau").Delete 'Xóa sheet trung gian "file_mau"
  wb.Save
  'wb.Close 'Dong file kq_kiem_tra.xlsx
Thoat:
  If Err.Number > 0 Then MsgBox ("Dong file kq_kiem_tra.xlsx truoc khi chay code")
  Application.ScreenUpdating = True
  Application.DisplayAlerts = True
  Set wb = Nothing
End Sub
 
Upvote 0
Bạn phải đăng nhập hoặc đăng ký để trả lời bài viết tại đây.
Web KT

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

Toanke063
  • Question
Xin hỏi code vba chuyển 1 file pdf bất kì thành ảnh
Trả lời
1
Đọc
2
befaint
befaint
T
Xin trợ giúp code về dò tìm dữ liệu
Trả lời
1
Đọc
68
CHAOQUAY
C
thlpro
Truy Vấn Công thức từ Sheet này Qua Sheet Khác
Trả lời
7
Đọc
127
CHAOQUAY
C
S
Lý do công thức bị mờ tại ô Function
    • Cười
Trả lời
2
Đọc
46
sakurasumo
S
GPE-Trợ Lý
Đăng ký tham dự hội thảo tại Hà Nội: Power Query - Công cụ quản lý dữ liệu
    • Thích
    • Cảm ơn
    • Yêu thích
Trả lời
5
Đọc
619
GPE-Trợ Lý
GPE-Trợ Lý
N
  • Question
Làm ơn viết giùm mình macro làm tròn giá trị ạ
    • Cười
Trả lời
14
Đọc
108
ptm0412
ptm0412
ongke0711
  • Question
Tải hóa đơn điện tử (https://hoadondientu.gdt.gov.vn/) Excel Vba
    • Thích
    • Yêu thích
8 9 10
Trả lời
191
Đọc
10K
ongke0711
ongke0711
CNKyNguyen
Giảm dung lượng của file excel
    • Cảm ơn
    • Cười
    • Thích
Trả lời
2
Đọc
230
CNKyNguyen
CNKyNguyen
hunganh.nguyen
Xin giúp code tách dòng tổng thành những dòng chi tiết với giá trị là 1
Trả lời
9
Đọc
404
vostro 1500
vostro 1500
P
Sự cố về hàm SUMIF
Trả lời
8
Đọc
232
yeudoi
yeudoi
OverAC
Thông báo nội dung xấu và bài viết vi phạm nội quy.
19 20 21
Trả lời
416
Đọc
41K
vanle33
vanle33
S
Chuyển định dạng thời gian từ sa/ch sang AM/PM
Trả lời
2
Đọc
70
Silklynk
S
B
Sắp xếp lịch trực
5 6 7
Trả lời
130
Đọc
86K
TTVAN28
TTVAN28
N
Giúp em hàm Aggregate không chạy được trên Google sheet ah
Trả lời
4
Đọc
141
nguyenthieny
N
N
  • Question
VBA - copy các sheets unhide và dạng giá trị theo vùng xác định
Trả lời
2
Đọc
87
bebo021999
B
hoaithanh9480
Nhờ giúp đỡ về kiểm phiếu bầu
Trả lời
4
Đọc
103
hoaithanh9480
hoaithanh9480
B
Nhờ anh/chị giúp em tìm hàm cho công thức tính lương
Trả lời
2
Đọc
137
hoangtuaotrang_hp_vn
H
SA_DQ
Phẩu thuật Nụ cười lần 3 tại Huế.
    • Thích
    • Yêu thích
Trả lời
1
Đọc
100
HUONGHCKT
H
K
  • Question
Sử dụng Power Query để xử lý nhật ký chung nhiều nợ nhiều có
    • Cười
Trả lời
14
Đọc
297
viethung78
V
N
cộng các dữ liệu không trùng nhau
Trả lời
13
Đọc
241
DeTong
D
Xem thêm…

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

Back
Top Bottom