Nhờ viết Code lấy dữ liệu tờ khai hải quan vào bảng tổng hợp

Liên hệ QC
Tôi tuân thủ nội quy khi đăng bài
Có
Tienvinh191

Tienvinh191

Thành viên mới
Tham gia
3/4/24
Bài viết
3
Được thích
5
Thường em phải lấy dữ liệu từ tờ khai hải quan vào bảng tổng hợp để làm tổng hợp và đối chiếu dữ liệu đầu vào.
Mỗi tờ khai hải quan bên em khá dài, có cái từ 20-50 trang, nhưng chia theo cấu trúc.
Do em cần tổng hợp dữ liệu ở tất cả các trang đấy vào một bảng tổng hợp, Mong các bác giúp em viết Code với nhé. Em tính lập công thức nhưng mãi không làm được, vẫn phải làm thủ công.
Trong file tổng hợp em có chỉ các ô để tổng hợp vào bảng, nhờ các bác hỗ trợ giúp em với
Em cũng đính kèm một file tờ khai và một file tổng hợp.
Cảm ơn các bác nhiều
tong hop.jpg
 

File đính kèm

  • TK 3.xls
    309.5 KB · Đọc: 72
  • Tong hop.xlsx
    57.1 KB · Đọc: 68
Sắp xếp theo thời gian sắp xếp theo bầu chọn
Tienvinh191 đã viết:
Thường em phải lấy dữ liệu từ tờ khai hải quan vào bảng tổng hợp để làm tổng hợp và đối chiếu dữ liệu đầu vào.
Mỗi tờ khai hải quan bên em khá dài, có cái từ 20-50 trang, nhưng chia theo cấu trúc.
Do em cần tổng hợp dữ liệu ở tất cả các trang đấy vào một bảng tổng hợp, Mong các bác giúp em viết Code với nhé. Em tính lập công thức nhưng mãi không làm được, vẫn phải làm thủ công.
Trong file tổng hợp em có chỉ các ô để tổng hợp vào bảng, nhờ các bác hỗ trợ giúp em với
Em cũng đính kèm một file tờ khai và một file tổng hợp.
Cảm ơn các bác nhiều
View attachment 299979
Nhấp chuột vào đây để mở rộng...
@Tienvinh191
Muốn hỏi Thêm bạn:
1/Có nhiều file như file TK 3.xsl cần tổng hợp không?
2/tronng các file cần tổng hợp ấy có nhiều sheet TKXK.... không hay chỉ có 1 sheet như vậy?
3/ Trong Sheet TKXK... ấy thì cố định 3 trang đầu (đến dòng 144) đều giống nhau hay có khác nhau. tức là Như hình của ảnh đính kèm thì chỉ tổng họp từ trang 3 (dòng 145)
4/... hay còn khác có những khác biệt khác.
 
Upvote 0
HUONGHCKT đã viết:
@Tienvinh191
Muốn hỏi Thêm bạn:
1/Có nhiều file như file TK 3.xsl cần tổng hợp không?
2/tronng các file cần tổng hợp ấy có nhiều sheet TKXK.... không hay chỉ có 1 sheet như vậy?
3/ Trong Sheet TKXK... ấy thì cố định 3 trang đầu (đến dòng 144) đều giống nhau hay có khác nhau. tức là Như hình của ảnh đính kèm thì chỉ tổng họp từ trang 3 (dòng 145)
4/... hay còn khác có những khác biệt khác.
Nhấp chuột vào đây để mở rộng...
Cảm ơn bạn, mình xin gửi bạn thêm thông tin như sau:
1. Mình có nhiều file như file TK3.xls cần tổng hợp bạn ah, nhưng để đơn giản thì có thể mình lấy từng file cũng đc bạn ah, còn nếu lấy được nhiều file một lúc thì quá tốt ah
2. Trong file cần tổng hợp thì chỉ có 1 sheet TKXK thôi bạn nhé.
3. Trong sheet TKXK thì 3 trang đầu thì đều giống nhau, số nội dung từ dòng 1-144. Mình chỉ cần tổng hợp từ trang 3 trở đi thôi bạn nhé
4. Các file như TK3.xls thì cơ bản giống nhau, chỉ khác nhau là có file thì nội dung cần lấy dài hơn, có file thì cần lấy nội dung ít hơn thôi
Cảm ơn bạn
 
Upvote 0
Tienvinh191 đã viết:
Thường em phải lấy dữ liệu từ tờ khai hải quan vào bảng tổng hợp để làm tổng hợp và đối chiếu dữ liệu đầu vào.
Mỗi tờ khai hải quan bên em khá dài, có cái từ 20-50 trang, nhưng chia theo cấu trúc.
Do em cần tổng hợp dữ liệu ở tất cả các trang đấy vào một bảng tổng hợp, Mong các bác giúp em viết Code với nhé. Em tính lập công thức nhưng mãi không làm được, vẫn phải làm thủ công.
Trong file tổng hợp em có chỉ các ô để tổng hợp vào bảng, nhờ các bác hỗ trợ giúp em với
Em cũng đính kèm một file tờ khai và một file tổng hợp.
Cảm ơn các bác nhiều
Nhấp chuột vào đây để mở rộng...
Chưa xử lý các con số
Mã: 
Sub LayDuLieu()
  Dim arr(), a, b, res(), FullFileName$
  Dim sRow&, i&, j&, k&, SoToKhai, Ngay As Date, HaiQuan$, stt$
 
  With Application.FileDialog(msoFileDialogFilePicker) 'Chon 1 File
    .AllowMultiSelect = False
    .Filters.Add "Excel Files", "*.xls*"
    If .Show = True Then
      FullFileName = .SelectedItems(1)
    Else
      MsgBox ("Chua Chon File Lay Du Lieu!")
      Exit Sub
    End If
  End With
 
  Application.ScreenUpdating = False
  Application.DisplayAlerts = False
  With Workbooks.Open(FullFileName).ActiveSheet 'Mo File và gán du lieu vao mang arr
    arr = .Range("C1:AA" & .Range("C65000").End(xlUp).Row).Value
    .Parent.Close False
  End With

  sRow = UBound(arr)
  For i = 1 To sRow
    If arr(i, 1) Like "S? t? khai" Then SoToKhai = arr(i, 3)
    If arr(i, 1) Like "Tên c? quan H?i quan ti?p nh?n t? khai" Then HaiQuan = arr(i, 8)
    If arr(i, 1) Like "Ngày ??ng ký" Then
      a = Split(Split(arr(i, 4), " ")(0), "/")
      Ngay = DateValue(a(2) & "/" & a(1) & "/" & a(0))
      Exit For
    End If
  Next i
  a = Array(, , , , , , 3, 6, 6, 7, 7, 8, 8, 10, 10, 11, 10, 11) 'Chenh lech dong voi dòng STT
  b = Array(, , , , , , 4, 15, 23, 15, 23, 4, 16, 5, 10, 5, 18, 16) 'thu tu cot
  ReDim res(1 To 99, 1 To 17)
  k = 1
  stt = Format(k, "\<00\>")
  For i = 1 To sRow
    If arr(i, 1) = stt Then
      res(k, 1) = SoToKhai
      res(k, 2) = Ngay
      res(k, 3) = HaiQuan
      res(k, 4) = arr(i + 2, 4)
      res(k, 5) = k
      For j = 6 To 17
        res(k, j) = arr(i + a(j), b(j))
      Next j
      k = k + 1 'Tim ma hang ke
      stt = Format(k, "\<00\>")
    End If
  Next i
  With Sheets("Sheet1")
    i = .Range("A65000").End(xlUp).Row
    If i > 4 Then .Range("A5:Q" & i).Clear
    If k > 1 Then
      .Range("A5").Resize(k - 1, 17) = res
      .Range("A5").Resize(k - 1, 17).Borders.LineStyle = 1
      .Range("A5").Resize(k - 1).NumberFormat = "#"
    End If
  End With
  Application.ScreenUpdating = True
  Application.DisplayAlerts = True
End Sub
 
Upvote 0
HieuCD đã viết:
Chưa xử lý các con số
Mã: 
Sub LayDuLieu()
  Dim arr(), a, b, res(), FullFileName$
  Dim sRow&, i&, j&, k&, SoToKhai, Ngay As Date, HaiQuan$, stt$
 
  With Application.FileDialog(msoFileDialogFilePicker) 'Chon 1 File
    .AllowMultiSelect = False
    .Filters.Add "Excel Files", "*.xls*"
    If .Show = True Then
      FullFileName = .SelectedItems(1)
    Else
      MsgBox ("Chua Chon File Lay Du Lieu!")
      Exit Sub
    End If
  End With
 
  Application.ScreenUpdating = False
  Application.DisplayAlerts = False
  With Workbooks.Open(FullFileName).ActiveSheet 'Mo File và gán du lieu vao mang arr
    arr = .Range("C1:AA" & .Range("C65000").End(xlUp).Row).Value
    .Parent.Close False
  End With

  sRow = UBound(arr)
  For i = 1 To sRow
    If arr(i, 1) Like "S? t? khai" Then SoToKhai = arr(i, 3)
    If arr(i, 1) Like "Tên c? quan H?i quan ti?p nh?n t? khai" Then HaiQuan = arr(i, 8)
    If arr(i, 1) Like "Ngày ??ng ký" Then
      a = Split(Split(arr(i, 4), " ")(0), "/")
      Ngay = DateValue(a(2) & "/" & a(1) & "/" & a(0))
      Exit For
    End If
  Next i
  a = Array(, , , , , , 3, 6, 6, 7, 7, 8, 8, 10, 10, 11, 10, 11) 'Chenh lech dong voi dòng STT
  b = Array(, , , , , , 4, 15, 23, 15, 23, 4, 16, 5, 10, 5, 18, 16) 'thu tu cot
  ReDim res(1 To 99, 1 To 17)
  k = 1
  stt = Format(k, "\<00\>")
  For i = 1 To sRow
    If arr(i, 1) = stt Then
      res(k, 1) = SoToKhai
      res(k, 2) = Ngay
      res(k, 3) = HaiQuan
      res(k, 4) = arr(i + 2, 4)
      res(k, 5) = k
      For j = 6 To 17
        res(k, j) = arr(i + a(j), b(j))
      Next j
      k = k + 1 'Tim ma hang ke
      stt = Format(k, "\<00\>")
    End If
  Next i
  With Sheets("Sheet1")
    i = .Range("A65000").End(xlUp).Row
    If i > 4 Then .Range("A5:Q" & i).Clear
    If k > 1 Then
      .Range("A5").Resize(k - 1, 17) = res
      .Range("A5").Resize(k - 1, 17).Borders.LineStyle = 1
      .Range("A5").Resize(k - 1).NumberFormat = "#"
    End If
  End With
  Application.ScreenUpdating = True
  Application.DisplayAlerts = True
End Sub
Nhấp chuột vào đây để mở rộng...
Cảm ơn bạn nhiều nhé
Mình sẽ sử dụng luôn
 
Upvote 0
HieuCD đã viết:
Chưa xử lý các con số
Mã: 
Sub LayDuLieu()
  Dim arr(), a, b, res(), FullFileName$
  Dim sRow&, i&, j&, k&, SoToKhai, Ngay As Date, HaiQuan$, stt$
 
  With Application.FileDialog(msoFileDialogFilePicker) 'Chon 1 File
    .AllowMultiSelect = False
    .Filters.Add "Excel Files", "*.xls*"
    If .Show = True Then
      FullFileName = .SelectedItems(1)
    Else
      MsgBox ("Chua Chon File Lay Du Lieu!")
      Exit Sub
    End If
  End With
 
  Application.ScreenUpdating = False
  Application.DisplayAlerts = False
  With Workbooks.Open(FullFileName).ActiveSheet 'Mo File và gán du lieu vao mang arr
    arr = .Range("C1:AA" & .Range("C65000").End(xlUp).Row).Value
    .Parent.Close False
  End With

  sRow = UBound(arr)
  For i = 1 To sRow
    If arr(i, 1) Like "S? t? khai" Then SoToKhai = arr(i, 3)
    If arr(i, 1) Like "Tên c? quan H?i quan ti?p nh?n t? khai" Then HaiQuan = arr(i, 8)
    If arr(i, 1) Like "Ngày ??ng ký" Then
      a = Split(Split(arr(i, 4), " ")(0), "/")
      Ngay = DateValue(a(2) & "/" & a(1) & "/" & a(0))
      Exit For
    End If
  Next i
  a = Array(, , , , , , 3, 6, 6, 7, 7, 8, 8, 10, 10, 11, 10, 11) 'Chenh lech dong voi dòng STT
  b = Array(, , , , , , 4, 15, 23, 15, 23, 4, 16, 5, 10, 5, 18, 16) 'thu tu cot
  ReDim res(1 To 99, 1 To 17)
  k = 1
  stt = Format(k, "\<00\>")
  For i = 1 To sRow
    If arr(i, 1) = stt Then
      res(k, 1) = SoToKhai
      res(k, 2) = Ngay
      res(k, 3) = HaiQuan
      res(k, 4) = arr(i + 2, 4)
      res(k, 5) = k
      For j = 6 To 17
        res(k, j) = arr(i + a(j), b(j))
      Next j
      k = k + 1 'Tim ma hang ke
      stt = Format(k, "\<00\>")
    End If
  Next i
  With Sheets("Sheet1")
    i = .Range("A65000").End(xlUp).Row
    If i > 4 Then .Range("A5:Q" & i).Clear
    If k > 1 Then
      .Range("A5").Resize(k - 1, 17) = res
      .Range("A5").Resize(k - 1, 17).Borders.LineStyle = 1
      .Range("A5").Resize(k - 1).NumberFormat = "#"
    End If
  End With
  Application.ScreenUpdating = True
  Application.DisplayAlerts = True
End Sub
Nhấp chuột vào đây để mở rộng...
Bác ơi,
Em rất cảm ơn bác vì code này (em cũng có thể tham khảo để sử dụng ạ)
Em có thêm một chút thắc mắc là hệ thống HQ của bên em nó đang ngược dấu phân cách dấu thập phân
nên khi xuất file dữ lệu ra con số nó bị sai
ví dụ 7530 thì nó hiển thị là 7.53 nên khi chạy code nó lại chỉ là 7.53 chứ không phải là 7530
bác xử lý giúp em phần này với ạ
Em cảm ơn bác rất nhiều ạ
 
Upvote 0
S.Ha đã viết:
Bác ơi,
Em rất cảm ơn bác vì code này (em cũng có thể tham khảo để sử dụng ạ)
Em có thêm một chút thắc mắc là hệ thống HQ của bên em nó đang ngược dấu phân cách dấu thập phân
nên khi xuất file dữ lệu ra con số nó bị sai
ví dụ 7530 thì nó hiển thị là 7.53 nên khi chạy code nó lại chỉ là 7.53 chứ không phải là 7530
bác xử lý giúp em phần này với ạ
Em cảm ơn bác rất nhiều ạ
Nhấp chuột vào đây để mở rộng...
Gởi dữ liệu gốc và chụp hình kết quả code chỗ bị sai số mới có hướng xử lý
 
Upvote 0
HieuCD đã viết:
Gởi dữ liệu gốc và chụp hình kết quả code chỗ bị sai số mới có hướng xử lý
Nhấp chuột vào đây để mở rộng...
Vâng thưa bác,
Em sẽ dùng chính file của chủ thớt làm ví dụ luôn cho dễ hiểu ạ
Ví dụ như tờ khai trang số 3 (Trang hiện tại đang bôi vàng)
đơn giá hóa đơn hiện tại là 13,100 (mười ba nghìn một trăm đồng) nhưng trên tờ khai hiển thị là 13.100 khi xuất dữ liệu ra nó sẽ hiển thị là 13.1
Lý do là hệ thống sử dụng dấu chấm để ngăn cách hàng nghìn của số ạ
Em muốn khi xuất dữ liệu ra nó vẫn hiển thị là 13100 hoặc 13,100 để đúng với thực tế là mười ba nghìn một trăm đồng ạ

Cũng vì lý do đó mà kết quả chạy ra mặc dù vốn dĩ đều là số nhưng một phần nó lại hiển thị ở dạng ký tự
ảnh em gửi kèm là kết quả của chính ví dụ của thớt ạ
 

File đính kèm

  • Capture.JPG
    Capture.JPG
    136.4 KB · Đọc: 33
Lần chỉnh sửa cuối:
Upvote 0
S.Ha đã viết:
Vâng thưa bác,
Em sẽ dùng chính file của chủ thớt làm ví dụ luôn cho dễ hiểu ạ
Ví dụ như tờ khai trang số 3 (Trang hiện tại đang bôi vàng)
đơn giá hóa đơn hiện tại là 13,100 (mười ba nghìn một trăm đồng) nhưng trên tờ khai hiển thị là 13.100 khi xuất dữ liệu ra nó sẽ hiển thị là 13.1
Lý do là hệ thống sử dụng dấu chấm để ngăn cách hàng nghìn của số ạ
Em muốn khi xuất dữ liệu ra nó vẫn hiển thị là 13100 hoặc 13,100 để đúng với thực tế là mười ba nghìn một trăm đồng ạ

Cũng vì lý do đó mà kết quả chạy ra mặc dù vốn dĩ đều là số nhưng một phần nó lại hiển thị ở dạng ký tự
ảnh em gửi kèm là kết quả của chính ví dụ của thớt ạ
Nhấp chuột vào đây để mở rộng...
Thêm lệnh xử lý chuỗi sang số
Mã: 
Sub LayDuLieu()
  Dim arr(), a, b, so, res(), FullFileName$
  Dim sRow&, i&, j&, k&, sSo&, SoToKhai, Ngay As Date, HaiQuan$, stt$
 
  With Application.FileDialog(msoFileDialogFilePicker) 'Chon 1 File
    .AllowMultiSelect = False
    .Filters.Add "Excel Files", "*.xls*"
    If .Show = True Then
      FullFileName = .SelectedItems(1)
    Else
      MsgBox ("Chua Chon File Lay Du Lieu!")
      Exit Sub
    End If
  End With
 
  Application.ScreenUpdating = False
  Application.DisplayAlerts = False
  With Workbooks.Open(FullFileName).ActiveSheet 'Mo File và gán du lieu vao mang arr
    arr = .Range("C1:AA" & .Range("C65000").End(xlUp).Row).Value
    .Parent.Close False
  End With

  sRow = UBound(arr)
  For i = 1 To sRow
    If arr(i, 1) Like "S? t? khai" Then SoToKhai = arr(i, 3)
    If arr(i, 1) Like "Tên c? quan H?i quan ti?p nh?n t? khai" Then HaiQuan = arr(i, 8)
    If arr(i, 1) Like "Ngày ??ng ký" Then
      a = Split(Split(arr(i, 4), " ")(0), "/")
      Ngay = DateValue(a(2) & "/" & a(1) & "/" & a(0))
      Exit For
    End If
  Next i
  a = Array(, , , , , , 3, 6, 6, 7, 7, 8, 8, 10, 10, 11, 10, 11) 'Chenh lech dong voi dòng STT
  b = Array(, , , , , , 4, 15, 23, 15, 23, 4, 16, 5, 10, 5, 18, 16) 'thu tu cot
  so = Array(7, 9, 11, 12, 13, 15, 16, 17) 'Cac cot ket qua la so
  sSo = UBound(so)
  ReDim res(1 To 99, 1 To 17)
  k = 1
  stt = Format(k, "\<00\>")
  For i = 1 To sRow
    If arr(i, 1) = stt Then
      res(k, 1) = SoToKhai
      res(k, 2) = Ngay
      res(k, 3) = HaiQuan
      res(k, 4) = arr(i + 2, 4)
      res(k, 5) = k
      For j = 6 To 17
        res(k, j) = arr(i + a(j), b(j))
      Next j
      For j = 0 To sSo
        res(k, so(j)) = Replace(Replace(res(k, so(j)), ".", ""), ",", ".")
      Next j
      k = k + 1 'Tim ma hang ke
      stt = Format(k, "\<00\>")
    End If
  Next i
  With Sheets("Sheet1")
    i = .Range("A65000").End(xlUp).Row
    If i > 4 Then .Range("A5:Q" & i).Clear
    If k > 1 Then
      .Range("A5").Resize(k - 1, 17) = res
      .Range("A5").Resize(k - 1, 17).Borders.LineStyle = 1
      .Range("A5").Resize(k - 1).NumberFormat = "#"
    End If
  End With
  Application.ScreenUpdating = True
  Application.DisplayAlerts = True
End Sub
 
Upvote 0
HieuCD đã viết:
Thêm lệnh xử lý chuỗi sang số
Mã: 
Sub LayDuLieu()
  Dim arr(), a, b, so, res(), FullFileName$
  Dim sRow&, i&, j&, k&, sSo&, SoToKhai, Ngay As Date, HaiQuan$, stt$
 
  With Application.FileDialog(msoFileDialogFilePicker) 'Chon 1 File
    .AllowMultiSelect = False
    .Filters.Add "Excel Files", "*.xls*"
    If .Show = True Then
      FullFileName = .SelectedItems(1)
    Else
      MsgBox ("Chua Chon File Lay Du Lieu!")
      Exit Sub
    End If
  End With
 
  Application.ScreenUpdating = False
  Application.DisplayAlerts = False
  With Workbooks.Open(FullFileName).ActiveSheet 'Mo File và gán du lieu vao mang arr
    arr = .Range("C1:AA" & .Range("C65000").End(xlUp).Row).Value
    .Parent.Close False
  End With

  sRow = UBound(arr)
  For i = 1 To sRow
    If arr(i, 1) Like "S? t? khai" Then SoToKhai = arr(i, 3)
    If arr(i, 1) Like "Tên c? quan H?i quan ti?p nh?n t? khai" Then HaiQuan = arr(i, 8)
    If arr(i, 1) Like "Ngày ??ng ký" Then
      a = Split(Split(arr(i, 4), " ")(0), "/")
      Ngay = DateValue(a(2) & "/" & a(1) & "/" & a(0))
      Exit For
    End If
  Next i
  a = Array(, , , , , , 3, 6, 6, 7, 7, 8, 8, 10, 10, 11, 10, 11) 'Chenh lech dong voi dòng STT
  b = Array(, , , , , , 4, 15, 23, 15, 23, 4, 16, 5, 10, 5, 18, 16) 'thu tu cot
  so = Array(7, 9, 11, 12, 13, 15, 16, 17) 'Cac cot ket qua la so
  sSo = UBound(so)
  ReDim res(1 To 99, 1 To 17)
  k = 1
  stt = Format(k, "\<00\>")
  For i = 1 To sRow
    If arr(i, 1) = stt Then
      res(k, 1) = SoToKhai
      res(k, 2) = Ngay
      res(k, 3) = HaiQuan
      res(k, 4) = arr(i + 2, 4)
      res(k, 5) = k
      For j = 6 To 17
        res(k, j) = arr(i + a(j), b(j))
      Next j
      For j = 0 To sSo
        res(k, so(j)) = Replace(Replace(res(k, so(j)), ".", ""), ",", ".")
      Next j
      k = k + 1 'Tim ma hang ke
      stt = Format(k, "\<00\>")
    End If
  Next i
  With Sheets("Sheet1")
    i = .Range("A65000").End(xlUp).Row
    If i > 4 Then .Range("A5:Q" & i).Clear
    If k > 1 Then
      .Range("A5").Resize(k - 1, 17) = res
      .Range("A5").Resize(k - 1, 17).Borders.LineStyle = 1
      .Range("A5").Resize(k - 1).NumberFormat = "#"
    End If
  End With
  Application.ScreenUpdating = True
  Application.DisplayAlerts = True
End Sub
Nhấp chuột vào đây để mở rộng...
Đỉnh cao!
em cứ nghĩ là sẽ phải thêm một module mới nữa mới xử lý được vấn đề phức tạp này
Em cảm ơn bác rất nhiều ạ
 
Upvote 0
HieuCD đã viết:
Thêm lệnh xử lý chuỗi sang số
Mã: 
Sub LayDuLieu()
  Dim arr(), a, b, so, res(), FullFileName$
  Dim sRow&, i&, j&, k&, sSo&, SoToKhai, Ngay As Date, HaiQuan$, stt$
 
  With Application.FileDialog(msoFileDialogFilePicker) 'Chon 1 File
    .AllowMultiSelect = False
    .Filters.Add "Excel Files", "*.xls*"
    If .Show = True Then
      FullFileName = .SelectedItems(1)
    Else
      MsgBox ("Chua Chon File Lay Du Lieu!")
      Exit Sub
    End If
  End With
 
  Application.ScreenUpdating = False
  Application.DisplayAlerts = False
  With Workbooks.Open(FullFileName).ActiveSheet 'Mo File và gán du lieu vao mang arr
    arr = .Range("C1:AA" & .Range("C65000").End(xlUp).Row).Value
    .Parent.Close False
  End With

  sRow = UBound(arr)
  For i = 1 To sRow
    If arr(i, 1) Like "S? t? khai" Then SoToKhai = arr(i, 3)
    If arr(i, 1) Like "Tên c? quan H?i quan ti?p nh?n t? khai" Then HaiQuan = arr(i, 8)
    If arr(i, 1) Like "Ngày ??ng ký" Then
      a = Split(Split(arr(i, 4), " ")(0), "/")
      Ngay = DateValue(a(2) & "/" & a(1) & "/" & a(0))
      Exit For
    End If
  Next i
  a = Array(, , , , , , 3, 6, 6, 7, 7, 8, 8, 10, 10, 11, 10, 11) 'Chenh lech dong voi dòng STT
  b = Array(, , , , , , 4, 15, 23, 15, 23, 4, 16, 5, 10, 5, 18, 16) 'thu tu cot
  so = Array(7, 9, 11, 12, 13, 15, 16, 17) 'Cac cot ket qua la so
  sSo = UBound(so)
  ReDim res(1 To 99, 1 To 17)
  k = 1
  stt = Format(k, "\<00\>")
  For i = 1 To sRow
    If arr(i, 1) = stt Then
      res(k, 1) = SoToKhai
      res(k, 2) = Ngay
      res(k, 3) = HaiQuan
      res(k, 4) = arr(i + 2, 4)
      res(k, 5) = k
      For j = 6 To 17
        res(k, j) = arr(i + a(j), b(j))
      Next j
      For j = 0 To sSo
        res(k, so(j)) = Replace(Replace(res(k, so(j)), ".", ""), ",", ".")
      Next j
      k = k + 1 'Tim ma hang ke
      stt = Format(k, "\<00\>")
    End If
  Next i
  With Sheets("Sheet1")
    i = .Range("A65000").End(xlUp).Row
    If i > 4 Then .Range("A5:Q" & i).Clear
    If k > 1 Then
      .Range("A5").Resize(k - 1, 17) = res
      .Range("A5").Resize(k - 1, 17).Borders.LineStyle = 1
      .Range("A5").Resize(k - 1).NumberFormat = "#"
    End If
  End With
  Application.ScreenUpdating = True
  Application.DisplayAlerts = True
End Sub
Nhấp chuột vào đây để mở rộng...
em chào anh Hiếu,
Nếu muốn lấy dữ liệu từ nhiều Tờ khai 1 lúc thì phải sửa code như thế nào vậy ạ.
 
Upvote 0
Buồn buồn nhảy vô code chơi:
Mở file Tong Hop và tất cả các các file có chứa sheet TKXK
Tại sheet Tong Hop chạy code này
PHP: 
Option Explicit
Sub LayDuLieu()
Dim wb As Workbook, ws As Worksheet
Dim stk$, ntk As Date, hq$, ad$, i&, k&, lr&, rng, res(1 To 1000, 1 To 17)
For Each wb In Workbooks
    For Each ws In wb.Sheets
        If ws.Name Like "TKXK*" Then
            wb.Activate
            ws.Activate
            stk = ws.Range("E4").Value
            ntk = Int(CDate(ws.Range("F8").Value))
            hq = ws.Range("J7").Value
            lr = ws.Cells(Rows.Count, "C").End(xlUp).Row
            rng = ws.Range("C1:AB" & lr).Value
            For i = 1 To UBound(rng)
                If rng(i, 1) Like "<*>" And IsNumeric(Mid(rng(i, 1), 2, 2)) Then
                    k = k + 1: res(k, 1) = stk: res(k, 2) = ntk: res(k, 3) = hq
                    res(k, 4) = rng(i + 2, 4): res(k, 5) = Mid(rng(i, 1), 2, 2)
                    res(k, 6) = rng(i + 3, 4): res(k, 7) = rng(i + 6, 15)
                    res(k, 8) = rng(i + 6, 23): res(k, 9) = rng(i + 7, 15)
                    res(k, 10) = rng(i + 7, 23)
                    With WorksheetFunction
                        res(k, 11) = .Substitute(rng(i + 8, 4), ".", "")
                        res(k, 12) = .Substitute(rng(i + 8, 16), ".", "")
                        res(k, 13) = .Substitute(rng(i + 10, 5), ".", "")
                        res(k, 14) = .Substitute(rng(i + 10, 12), ".", "")
                        res(k, 15) = .Substitute(rng(i + 11, 5), ".", "")
                        res(k, 16) = .Substitute(rng(i + 10, 18), ".", "")
                        res(k, 17) = .Substitute(rng(i + 11, 16), ".", "")
                    End With
                End If
            Next
        End If
    Next
Next
Workbooks("Tong hop").Worksheets("Sheet1").Activate
Range("A5:Q1000").ClearContents
Range("A5").Resize(k, 17).Value = res
End Sub
 
Upvote 0
huevantran đã viết:
Dạ kết quả như trong file tổng hợp của bài là được anh ạ, điền dữ liệu của tờ khai 1 xong sẽ điền tiếp dữ liệu của tờ khai 2 vào hàng liền kề kế tiếp, cứ như vậy cho các tờ khai còn lại.
Nhấp chuột vào đây để mở rộng...
Test thử với code bài #13 nhé bạn
 
Upvote 0
Bảo đảm:
- Các sheet chứa tờ khai phãi có tên sheet bắt đầu là "TKXK"
- Kết cấu, vị trí dữ liệu giống nhau
VD: các số thứ tự hàng có dạng <01>, <02>,...và nằm trong cột C
 
Upvote 0
bebo021999 đã viết:
Bảo đảm:
- Các sheet chứa tờ khai phãi có tên sheet bắt đầu là "TKXK"
- Kết cấu, vị trí dữ liệu giống nhau
VD: các số thứ tự hàng có dạng <01>, <02>,...và nằm trong cột C
Nhấp chuột vào đây để mở rộng...
Tờ khai XK mặc định của hệ thống hải quan có tên sheet khác anh ạ, em đã thử đổi lại tên sheet thành TKXK thì code cho ra kết quả đúng, tuy nhiên số tờ khai không hiển thị đúng, và chỗ số lượng bị lỗi dấu ngăn cách đơn vị hàng nghìn và thập phân.

1713338226938.png
 
Lần chỉnh sửa cuối:
Upvote 0
Trong code mình có dùng hàm SUBSTITUTE để xóa các dấu chấm (như file mẫu thì không có số lẻ, nên không có dấu phảy).
Nếu số có dạng: 1.000,50 (1 ngàn lẻ năm) thì ngoài bước xóa dấu chấm (thành là 1000,50), còn thêm 1 bước thay dấu "," bằng ".", thành 1000.5 (Lồng thêm 1 substitute nữa)
VD dòng này:
res(k, 11) = .Substitute(rng(i + 8, 4), ".", "")
sửa thành
res(k, 11) = .Substitute(.Substitute(rng(i + 8, 4), ".", ""),",",".")
Làm tương tự cho các dòng còn lại
 
Upvote 0
huevantran đã viết:
Dạ kết quả như trong file tổng hợp của bài là được anh ạ, điền dữ liệu của tờ khai 1 xong sẽ điền tiếp dữ liệu của tờ khai 2 vào hàng liền kề kế tiếp, cứ như vậy cho các tờ khai còn lại.
Nhấp chuột vào đây để mở rộng...
Chọn nhiều file. Kiểm tra lại . .
Mã: 
Sub LayDuLieu()
  Dim arr(), a, b, S, so, res(), sFile, sh As Worksheet, FullFileName
  Dim sRow&, i&, j&, k&, t&, sSo&, SoToKhai, Ngay As Date, HaiQuan$, stt$
 
  With Application.FileDialog(msoFileDialogFilePicker) 'Chon 1 File
    .AllowMultiSelect = True
    .Filters.Add "Excel Files", "*.xls*"
    If .Show = True Then
      Set sFile = .SelectedItems
    Else
      MsgBox ("Chua Chon File Lay Du Lieu!")
      Exit Sub
    End If
  End With
 
  a = Array(, , , , , , 3, 6, 6, 7, 7, 8, 8, 10, 10, 11, 10, 11) 'Chenh lech dong voi dòng STT
  b = Array(, , , , , , 4, 15, 23, 15, 23, 4, 16, 5, 10, 5, 18, 16) 'thu tu cot
  so = Array(7, 9, 11, 12, 13, 15, 16, 17) 'Cac cot ket qua la so
  sSo = UBound(so)
  ReDim res(1 To 99999, 1 To 17)
  Set sh = Sheets("Sheet1")
  Application.ScreenUpdating = False
  Application.DisplayAlerts = False
 
  For Each FullFileName In sFile
    With Workbooks.Open(FullFileName).ActiveSheet 'Mo File và gán du lieu vao mang arr
      arr = .Range("C1:AA" & .Range("C65000").End(xlUp).Row).Value
      .Parent.Close False
    End With

    sRow = UBound(arr)
    For i = 1 To sRow
      If arr(i, 1) Like "S? t? khai" Then SoToKhai = arr(i, 3)
      If arr(i, 1) Like "Tên c? quan H?i quan ti?p nh?n t? khai" Then HaiQuan = arr(i, 8)
      If arr(i, 1) Like "Ngày ??ng ký" Then
        S = Split(Split(arr(i, 4), " ")(0), "/")
        Ngay = DateValue(S(2) & "/" & S(1) & "/" & S(0))
        Exit For
      End If
    Next i

    t = 1
    stt = Format(t, "\<00\>")
    For i = 1 To sRow
      If arr(i, 1) = stt Then
        k = k + 1
        res(k, 1) = SoToKhai
        res(k, 2) = Ngay
        res(k, 3) = HaiQuan
        res(k, 4) = arr(i + 2, 4)
        res(k, 5) = k
        For j = 6 To 17
          res(k, j) = arr(i + a(j), b(j))
        Next j
        For j = 0 To sSo
          res(k, so(j)) = Replace(Replace(res(k, so(j)), ".", ""), ",", ".")
        Next j
        t = t + 1 'Tim ma hang ke
        stt = Format(t, "\<00\>")
      End If
    Next i
    i = sh.Range("A65000").End(xlUp).Row
    If i > 4 Then sh.Range("A5:Q" & i).Clear
    If k > 1 Then
      sh.Range("A5").Resize(k, 17) = res
      sh.Range("A5").Resize(k, 17).Borders.LineStyle = 1
      sh.Range("A5").Resize(k).NumberFormat = "#"
    End If
  Next FullFileName
  Application.ScreenUpdating = True
  Application.DisplayAlerts = True
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

salam
Ẩn ảnh sau chữ trong excel
Trả lời
11
Đọc
29K
itusbbk
itusbbk
nobita994
Trừ số lượng dần theo dòng khi quét Sumif tổng có tên sản phẩm bị trùng.
Trả lời
4
Đọc
92
nobita994
nobita994
F
  • Question
Nhờ tư vấn cách tạo QR trong Excel
Trả lời
7
Đọc
519
huuthang_bd
huuthang_bd
nguyen trung cuong
File chứa marco không mở được.
Trả lời
3
Đọc
92
hvnhpro
H
Tienvinh191
  • Question
Nhờ viết Code lấy dữ liệu tờ khai hải quan vào bảng tổng hợp
2
Trả lời
25
Đọc
2K
haott
H
H
Hỗ trợ lấy danh sách dữ liệu thỏa mãn điều kiện
Trả lời
2
Đọc
103
NT Ngoc Yen
N
CodyPham97
tạo biểu tượng thay thế nhấn đúp chuột
Trả lời
4
Đọc
91
phansythao
phansythao
dovanha1994
Giúp e tìm nguyên nhân sai và hướng dẫn e đọc file này với ạ
    • Phẫn nộ
Trả lời
4
Đọc
123
SA_DQ
SA_DQ
20050911
File Excel lỗi ''The file could not be accessed. Try one of the following:.."
Trả lời
10
Đọc
543
20050911
20050911
N
Giúp sửa mã code
2
Trả lời
20
Đọc
457
Nguyễn Diêu Hiền
N
GPE-Trợ Lý
MỪNG NGÀY NHÀ GIÁO VIỆT NAM 20/11/2024
    • Thích
    • Yêu thích
Trả lời
1
Đọc
90
SA_DQ
SA_DQ
Tuấn Bụng Bự
  • Question
Tìm Bộ 8 số xuất hiện nhiều nhất trong random( 1 - 80)
2
Trả lời
32
Đọc
867
VetMini
V
K
Nhờ mọi người hoàn thiện giúp công thức
Trả lời
4
Đọc
112
kiendt1973
K
P
Nhờ giúp đỡ hàm lọc dữ liệu theo tỉnh
Trả lời
10
Đọc
173
Parabol
P
H
Chúc mừng 20/11- ngày tôn vinh nhà giáo Việt Nam.
    • Thích
    • Yêu thích
Trả lời
0
Đọc
66
HUONGHCKT
H
N
Vẽ biểu đồ kết hợp nhiều yếu tố trong excel
Trả lời
7
Đọc
197
Ny Ny 2024
N
Nhật Anh 9x
  • Question
Tính tồn cuối kỳ luỹ kế cho nhiều mã
Trả lời
2
Đọc
107
Nhật Anh 9x
Nhật Anh 9x
C
Chia sẻ: Kết quả xổ số Keno
    • Cười
    • Thích
2
Trả lời
20
Đọc
592
ptm0412
ptm0412
huynhnhu1234
Tìm giá vé máy bay một chiều và khứ hồi
Trả lời
1
Đọc
119
hvnhpro
H
PhanTuHuong
Bàn về môn thể thao bóng bàn nào!
    • Thích
    • Yêu thích
    • Cười
2
Trả lời
37
Đọc
2K
cantl
C
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