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

[Tienvinh191]

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

 

[huevantran]

Chọn nhiều file. Kiểm tra lại . .

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

Em đã chạy thử code lấy dữ liệu cùng lúc cho 2 tờ khai, mỗi tờ khai có 2 mặt hàng, cột số thứ tự hàng đang đếm là 1 2 3 4, nếu đúng thì phải đếm là 1 2 1 2 anh ạ.

 

[BuiQuangThuan]

Em đã chạy thử code lấy dữ liệu cùng lúc cho 2 tờ khai, mỗi tờ khai có 2 mặt hàng, cột số thứ tự hàng đang đếm là 1 2 3 4, nếu đúng thì phải đếm là 1 2 1 2 anh ạ.
View attachment 300299

Ban nên đính kèm tờ khai mà bạn nói lên xem thế nào. tại mình đang hình dung nếu có thật thì nó sẽ lấy theo quy luật 1,2,3,4......đến hết xong quay về 1,2,3,4.... của tờ khai tiếp theo á

 

[HieuCD]

Em đã chạy thử code lấy dữ liệu cùng lúc cho 2 tờ khai, mỗi tờ khai có 2 mặt hàng, cột số thứ tự hàng đang đếm là 1 2 3 4, nếu đúng thì phải đếm là 1 2 1 2 anh ạ.
View attachment 300299

res(k, 5) = k
Chỉnh lại
res(k, 5) = t

 

[huevantran]

res(k, 5) = k
Chỉnh lại
res(k, 5) = t

Kết quả trả về đúng rồi anh nha, cảm ơn anh Hiếu rất nhiều.