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

Tienvinh191 · 4/4/24

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

HUONGHCKT · 4/4/24

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

@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.

Tienvinh191 · 5/4/24

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.

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

HieuCD · 5/4/24

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

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

Tienvinh191 · 6/4/24

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

Cảm ơn bạn nhiều nhé
Mình sẽ sử dụng luôn

S.Ha · 13/4/24

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

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 ạ

HieuCD · 14/4/24

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 ạ

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ý

S.Ha · 16/4/24

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ý

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 ạ

HieuCD · 17/4/24

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 ạ

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

S.Ha · 17/4/24

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 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 ạ

huevantran · 17/4/24

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

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 ạ.

HieuCD · 17/4/24

huevantran đã viết:
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 ạ.

Kết quả trình bày như thế nào?

bebo021999 · 17/4/24

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

huevantran · 17/4/24

HieuCD đã viết:
Kết quả trình bày như thế nào?

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.

bebo021999 · 17/4/24

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.

Test thử với code bài #13 nhé bạn

huevantran · 17/4/24

bebo021999 đã viết:
Test thử với code bài #13 nhé bạn

Dạ, lúc nãy em có thử mở file Tonghop và 2 file tờ khai XK, chạy code của anh thì báo lỗi ạ.

bebo021999 · 17/4/24

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

huevantran · 17/4/24

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

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.

bebo021999 · 17/4/24

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

HieuCD · 17/4/24

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.

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

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

Thành viên mới

File đính kèm

Zalo 0986997214

Thành viên mới

Chuyên gia GPE

Thành viên mới

Thành viên mới

Chuyên gia GPE

Thành viên mới

File đính kèm

Chuyên gia GPE

Thành viên mới

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

Chuyên gia GPE

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

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

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

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

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

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

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

Chuyên gia GPE

Facebook

Group