Tạo bảng Excel tổng hợp lấy dữ liệu từ các file đơn lẻ

Liên hệ QC
hoangluongvinh

hoangluongvinh

Thành viên mới
Tham gia
29/7/15
Bài viết
17
Được thích
2
Chào mọi người, mình hay phải làm các báo cáo tổng hợp từ các file dữ liệu hàng tháng về bán hàng. Trước giờ mình vẫn có 1 file tổng hợp, trong đó gồm các sheet lần lượt là các tháng T1, T2, T3... Khi làm mình sẽ copy lần lượt các dữ liệu (dạng đơn giản ở phần mềm quản lý xuất ra) ở các file T1.xls, T2.xls ... vào các sheet ở trên thấy cũng khá mất công, vì các thao tác lặp đi lặp lại giống nhau.
Nay nhờ mọi người giúp mình đơn giản hóa công việc trên với. Ý tưởng là mình sẽ xuất toàn bộ các file T1.xls, T2.xls.. đến T12, sau đó vào file TONG HOP.xls chạy code để lấy toàn bộ dữ liệu ở các file trên vào các sheet ở biểu tổng hợp, và các sheet này theo 1 định dạng cho trước. Sau đó sheet tổng hợp sẽ bao gồm dữ liệu tổng của các sheet T1 đến T12.
Mình trước giờ cũng vận dụng được rất nhiều kiến thức trên diễn đàn vào công việc, nhưng chưa tự tạo được cái code nào cả :) Mong mọi người giúp đỡ. Cảm ơn mọi người nhiều ;;;;;;;;;;;
À mình đính kèm thêm 1 file dữ liệu cho các bác dễ hình dung ạ.
 

File đính kèm

  • TONG HOP.zip
    21.5 KB · Đọc: 33
hoangluongvinh đã viết:
Chào mọi người, mình hay phải làm các báo cáo tổng hợp từ các file dữ liệu hàng tháng về bán hàng. Trước giờ mình vẫn có 1 file tổng hợp, trong đó gồm các sheet lần lượt là các tháng T1, T2, T3... Khi làm mình sẽ copy lần lượt các dữ liệu (dạng đơn giản ở phần mềm quản lý xuất ra) ở các file T1.xls, T2.xls ... vào các sheet ở trên thấy cũng khá mất công, vì các thao tác lặp đi lặp lại giống nhau.
Nay nhờ mọi người giúp mình đơn giản hóa công việc trên với. Ý tưởng là mình sẽ xuất toàn bộ các file T1.xls, T2.xls.. đến T12, sau đó vào file TONG HOP.xls chạy code để lấy toàn bộ dữ liệu ở các file trên vào các sheet ở biểu tổng hợp, và các sheet này theo 1 định dạng cho trước. Sau đó sheet tổng hợp sẽ bao gồm dữ liệu tổng của các sheet T1 đến T12.
Mình trước giờ cũng vận dụng được rất nhiều kiến thức trên diễn đàn vào công việc, nhưng chưa tự tạo được cái code nào cả :) Mong mọi người giúp đỡ. Cảm ơn mọi người nhiều ;;;;;;;;;;;
À mình đính kèm thêm 1 file dữ liệu cho các bác dễ hình dung ạ.
Nhấp chuột vào đây để mở rộng...
giải nén file và mở file tong hop, bấm ngôi sao chạy code
code viết cho 12 tháng, nếu có đủ 12 tháng thì bạn tự thêm các sheet T3, T4...vào
 

File đính kèm

  • TONG HOP.rar
    30.2 KB · Đọc: 52
Cùng một mục đích xin nhờ cao nhân :
Mình muốn tổng hợp các chi tiết của nhiều mã hàng ( các mã có dùng chung nguyen phụ liệu )
nhờ bạn giúp để có tổng hợp số lượng của từng loại vải, phụ liệu của chung các mã hàng trong sheet tổng hợp chung

xin cảm ơn
 

File đính kèm

  • TONG HOP MA HANG.xlsx
    11.4 KB · Đọc: 16
ljnkon đã viết:
Cùng một mục đích xin nhờ cao nhân :
Mình muốn tổng hợp các chi tiết của nhiều mã hàng ( các mã có dùng chung nguyen phụ liệu )
nhờ bạn giúp để có tổng hợp số lượng của từng loại vải, phụ liệu của chung các mã hàng trong sheet tổng hợp chung
xin cảm ơn
Nhấp chuột vào đây để mở rộng...
nơi ở của mình có trồng mấy cây khá cao gọi là cây cao không ai gọi là cao cây, cao nhân nghe giống tiểu thuyết kiếm hiệp xa xưa quá, tiếng Việt có rất nhiều từ thân thiện và thuần Việt sao không dùng mà lại sử dùng từ Hán Việt của các thế kỹ trước
bạn bấm ngôi sao chạy code
 

File đính kèm

  • TONG HOP MA HANG.xlsb
    21.3 KB · Đọc: 28
HieuCD đã viết:
giải nén file và mở file tong hop, bấm ngôi sao chạy code
code viết cho 12 tháng, nếu có đủ 12 tháng thì bạn tự thêm các sheet T3, T4...vào
Nhấp chuột vào đây để mở rộng...
Bác Hiếu ơi, mình hỏi thêm chút, nếu muốn lấy thêm thông tin các cột nữa ở các tháng, mà các cột không liền nhau thì làm thế nào bác nhỉ?
Sorry bác vì trước mình cắt cúp đi để đơn giản hóa, tình thử lấy file của bác về vận dụng thêm mà khó quá trời @@
 

File đính kèm

  • TONG HOP.zip
    33.3 KB · Đọc: 33
hoangluongvinh đã viết:
Bác Hiếu ơi, mình hỏi thêm chút, nếu muốn lấy thêm thông tin các cột nữa ở các tháng, mà các cột không liền nhau thì làm thế nào bác nhỉ?
Sorry bác vì trước mình cắt cúp đi để đơn giản hóa, tình thử lấy file của bác về vận dụng thêm mà khó quá trời @@
Nhấp chuột vào đây để mở rộng...
bạn chạy code
Mã: 
Sub TongHop()
Dim WB As Workbook, FSO As Object, WBname As String
Dim Darr(), Arr(), Farr As Variant, LastR As Long, i As Long, f As Byte
  Application.ScreenUpdating = False
  Sheets("TONG HOP").Range("B4:C15").ClearContents
  On Error GoTo Thoat
  Path = ThisWorkbook.Path & "\"
  Farr = Array("T1", "T2", "T3", "T4", "T5", "T6", "T7", "T8", "T9", "T10", "T11", "T12")
  Set FSO = CreateObject("Scripting.FileSystemObject")
  For f = 0 To UBound(Farr)
    If FSO.FileExists(Path & Farr(f) & ".xls") Then
      Set WB = Workbooks.Open(Path & Farr(f) & ".xls")
      WBname = FSO.GetBaseName(WB.Name)
      LastR = Range("D65000").End(xlUp).Row
      Darr = Range("D2:Q" & LastR).Value
      ReDim Arr(1 To UBound(Darr) + 1, 1 To 7)
      WB.Close False
      If LastR > 1 Then
        For i = 1 To UBound(Darr)
          Arr(i, 1) = i:            Arr(i, 2) = Darr(i, 1)
          Arr(i, 3) = Darr(i, 2):   Arr(i, 4) = Darr(i, 4)
          Arr(i, 5) = Darr(i, 14):   Arr(i, 6) = Darr(i, 5)
          Arr(i, 7) = Darr(i, 8)
          Arr(UBound(Darr) + 1, 6) = Arr(UBound(Darr) + 1, 6) + Darr(i, 5)
          Arr(UBound(Darr) + 1, 7) = Arr(UBound(Darr) + 1, 7) + Darr(i, 8)
        Next i
        Arr(UBound(Darr) + 1, 2) = "T" & ChrW(7893) & "ng"
        Sheets(WBname).Range("A6:G1000").Clear
        Sheets(WBname).Range("A6").Resize(UBound(Arr), 7) = Arr
        Sheets(WBname).Range("A5").Resize(UBound(Arr) + 1, 9).Borders.LineStyle = 1
        Sheets("TONG HOP").Range("C" & Mid(WBname, 2, Len(WBname) - 1)).Offset(3, 0) = Arr(UBound(Arr), 7)
      End If
    End If
  Next f
  Set FSO = Nothing:  Set WB = Nothing:  Erase Darr:  Erase Arr
Thoat:
  Application.ScreenUpdating = True
End Sub
 
HieuCD đã viết:
bạn chạy code
Mã: 
Sub TongHop()
Dim WB As Workbook, FSO As Object, WBname As String
Dim Darr(), Arr(), Farr As Variant, LastR As Long, i As Long, f As Byte
  Application.ScreenUpdating = False
  Sheets("TONG HOP").Range("B4:C15").ClearContents
  On Error GoTo Thoat
  Path = ThisWorkbook.Path & "\"
  Farr = Array("T1", "T2", "T3", "T4", "T5", "T6", "T7", "T8", "T9", "T10", "T11", "T12")
  Set FSO = CreateObject("Scripting.FileSystemObject")
  For f = 0 To UBound(Farr)
    If FSO.FileExists(Path & Farr(f) & ".xls") Then
      Set WB = Workbooks.Open(Path & Farr(f) & ".xls")
      WBname = FSO.GetBaseName(WB.Name)
      LastR = Range("D65000").End(xlUp).Row
      Darr = Range("D2:Q" & LastR).Value
      ReDim Arr(1 To UBound(Darr) + 1, 1 To 7)
      WB.Close False
      If LastR > 1 Then
        For i = 1 To UBound(Darr)
          Arr(i, 1) = i:            Arr(i, 2) = Darr(i, 1)
          Arr(i, 3) = Darr(i, 2):   Arr(i, 4) = Darr(i, 4)
          Arr(i, 5) = Darr(i, 14):   Arr(i, 6) = Darr(i, 5)
          Arr(i, 7) = Darr(i, 8)
          Arr(UBound(Darr) + 1, 6) = Arr(UBound(Darr) + 1, 6) + Darr(i, 5)
          Arr(UBound(Darr) + 1, 7) = Arr(UBound(Darr) + 1, 7) + Darr(i, 8)
        Next i
        Arr(UBound(Darr) + 1, 2) = "T" & ChrW(7893) & "ng"
        Sheets(WBname).Range("A6:G1000").Clear
        Sheets(WBname).Range("A6").Resize(UBound(Arr), 7) = Arr
        Sheets(WBname).Range("A5").Resize(UBound(Arr) + 1, 9).Borders.LineStyle = 1
        Sheets("TONG HOP").Range("C" & Mid(WBname, 2, Len(WBname) - 1)).Offset(3, 0) = Arr(UBound(Arr), 7)
      End If
    End If
  Next f
  Set FSO = Nothing:  Set WB = Nothing:  Erase Darr:  Erase Arr
Thoat:
  Application.ScreenUpdating = True
End Sub
Nhấp chuột vào đây để mở rộng...
Thank bác nhiều nhiều ạ }}}}}
 
@HieuCD thầy ơi giúp em thêm một chút về sử dụng hàm vlookup trong vba này đươc không ạ? Em muốn khi chạy đoạn code tổng hợp thì cột STK ở các sheet T1, T2 tự vlookup STK ở file STK.xls ạ.
 

File đính kèm

  • 2021.zip
    222 KB · Đọc: 21
hoangluongvinh đã viết:
@HieuCD thầy ơi giúp em thêm một chút về sử dụng hàm vlookup trong vba này đươc không ạ? Em muốn khi chạy đoạn code tổng hợp thì cột STK ở các sheet T1, T2 tự vlookup STK ở file STK.xls ạ.
Nhấp chuột vào đây để mở rộng...
Sao không lưu sheet STK vào chung với file Tonghop để viết công thức hay code đều thuận tiện
 
hoangluongvinh đã viết:
@HieuCD thầy ơi giúp em thêm một chút về sử dụng hàm vlookup trong vba này đươc không ạ? Em muốn khi chạy đoạn code tổng hợp thì cột STK ở các sheet T1, T2 tự vlookup STK ở file STK.xls ạ.
Nhấp chuột vào đây để mở rộng...
Chỉnh lại code
Mã: 
Sub TongHop()
Dim WB As Workbook, FSO As Object, WBname As String, Dic As Object
Dim Darr(), Arr(), LastR As Long, i As Long, R As Long, f As Byte
  Application.ScreenUpdating = False
  Application.DisplayAlerts = False
  On Error Resume Next
  Path = ThisWorkbook.Path & "\"
  Set FSO = CreateObject("Scripting.FileSystemObject")
 
  Set WB = Workbooks.Open(Path & "STK.xlsx")
  With WB.Sheets("Sheet1")
    Darr = .Range("A2", .Range("E" & Rows.Count).End(xlUp)).Value
  End With
  WB.Close False
  Set Dic = CreateObject("scripting.dictionary")
  R = UBound(Darr)
  For i = 1 To R
    If Darr(i, 1) <> Empty Then Dic.Item(Darr(i, 1)) = Darr(i, 5)
  Next i
  For f = 1 To 14
    If FSO.FileExists(Path & "T" & f & ".xls") Then
      Set WB = Workbooks.Open(Path & "T" & f & ".xls")
      WBname = FSO.GetBaseName(WB.Name)
      LastR = Range("D65000").End(xlUp).Row
      Darr = Range("D2:Q" & LastR).Value
      R = UBound(Darr)
      ReDim Arr(1 To R + 1, 1 To 9)
      WB.Close False
      If LastR > 1 Then
        For i = 1 To R
          Arr(i, 1) = i
          Arr(i, 2) = Darr(i, 1)
          Arr(i, 3) = Darr(i, 2)
          Arr(i, 4) = Darr(i, 3)
          If Dic.exists(Arr(i, 4)) Then Arr(i, 5) = Dic.Item(Arr(i, 4))
          Arr(i, 6) = Darr(i, 5)
          Arr(i, 7) = Darr(i, 8)
          Arr(R + 1, 6) = Arr(R + 1, 6) + Darr(i, 5)
          Arr(R + 1, 7) = Arr(R + 1, 7) + Darr(i, 8)
        Next i
        Arr(R + 1, 2) = "T" & ChrW(7893) & "ng"
        With Sheets(WBname)
          .Range("A6:I1000").ClearContents
          .Range("A6:I1000").ClearFormats
          .Range("D6").Resize(R + 1, 2).NumberFormat = "@"
          .Range("A6").Resize(R + 1, 7) = Arr
          .Cells(R + 8, 3) = Sheets("TONG HOP").Range("B20")
          .Cells(R + 8, 7) = Sheets("TONG HOP").Range("E20")
          .Range("A5").Resize(R + 2, 9).Borders.LineStyle = 1
          .Range("B6").Resize(R + 1).NumberFormat = "#############"
          .Range("F6").Resize(R + 1, 3).NumberFormat = "#,###"
        End With
        Sheets("TONG HOP").Range("D4:D17").ClearContents
        Sheets("TONG HOP").Range("E" & f).Offset(3, 0) = Arr(R + 1, 7)
        Range("G4").Resize(R + 1, 3).NumberFormat = "#,###"
      End If
    End If
  Next f
  Set FSO = Nothing:  Set WB = Nothing:  Erase Darr:  Erase Arr
  Application.DisplayAlerts = False
  Application.ScreenUpdating = True
End Sub
 
HieuCD đã viết:
Chỉnh lại code
Mã: 
Sub TongHop()
Dim WB As Workbook, FSO As Object, WBname As String, Dic As Object
Dim Darr(), Arr(), LastR As Long, i As Long, R As Long, f As Byte
  Application.ScreenUpdating = False
  Application.DisplayAlerts = False
  On Error Resume Next
  Path = ThisWorkbook.Path & "\"
  Set FSO = CreateObject("Scripting.FileSystemObject")

  Set WB = Workbooks.Open(Path & "STK.xlsx")
  With WB.Sheets("Sheet1")
    Darr = .Range("A2", .Range("E" & Rows.Count).End(xlUp)).Value
  End With
  WB.Close False
  Set Dic = CreateObject("scripting.dictionary")
  R = UBound(Darr)
  For i = 1 To R
    If Darr(i, 1) <> Empty Then Dic.Item(Darr(i, 1)) = Darr(i, 5)
  Next i
  For f = 1 To 14
    If FSO.FileExists(Path & "T" & f & ".xls") Then
      Set WB = Workbooks.Open(Path & "T" & f & ".xls")
      WBname = FSO.GetBaseName(WB.Name)
      LastR = Range("D65000").End(xlUp).Row
      Darr = Range("D2:Q" & LastR).Value
      R = UBound(Darr)
      ReDim Arr(1 To R + 1, 1 To 9)
      WB.Close False
      If LastR > 1 Then
        For i = 1 To R
          Arr(i, 1) = i
          Arr(i, 2) = Darr(i, 1)
          Arr(i, 3) = Darr(i, 2)
          Arr(i, 4) = Darr(i, 3)
          If Dic.exists(Arr(i, 4)) Then Arr(i, 5) = Dic.Item(Arr(i, 4))
          Arr(i, 6) = Darr(i, 5)
          Arr(i, 7) = Darr(i, 8)
          Arr(R + 1, 6) = Arr(R + 1, 6) + Darr(i, 5)
          Arr(R + 1, 7) = Arr(R + 1, 7) + Darr(i, 8)
        Next i
        Arr(R + 1, 2) = "T" & ChrW(7893) & "ng"
        With Sheets(WBname)
          .Range("A6:I1000").ClearContents
          .Range("A6:I1000").ClearFormats
          .Range("D6").Resize(R + 1, 2).NumberFormat = "@"
          .Range("A6").Resize(R + 1, 7) = Arr
          .Cells(R + 8, 3) = Sheets("TONG HOP").Range("B20")
          .Cells(R + 8, 7) = Sheets("TONG HOP").Range("E20")
          .Range("A5").Resize(R + 2, 9).Borders.LineStyle = 1
          .Range("B6").Resize(R + 1).NumberFormat = "#############"
          .Range("F6").Resize(R + 1, 3).NumberFormat = "#,###"
        End With
        Sheets("TONG HOP").Range("D4:D17").ClearContents
        Sheets("TONG HOP").Range("E" & f).Offset(3, 0) = Arr(R + 1, 7)
        Range("G4").Resize(R + 1, 3).NumberFormat = "#,###"
      End If
    End If
  Next f
  Set FSO = Nothing:  Set WB = Nothing:  Erase Darr:  Erase Arr
  Application.DisplayAlerts = False
  Application.ScreenUpdating = True
End Sub
Nhấp chuột vào đây để mở rộng...
Cám ơn thầy nhiều ạ ^^
 
HieuCD đã viết:
Chỉnh lại code
Nhấp chuột vào đây để mở rộng...
Em muốn làm nốt 1 bước cuối nữa như này được không hả thầy: Ví dụ cuối ngày sau khi thu được ở các T1, T2... một số khách hàng, em muốn chạy thêm một lệnh nữa để nhặt riêng các khách hàng này ra 1 sheet "KH DA NOP LAI" nữa ạ.
 
hoangluongvinh đã viết:
Em muốn làm nốt 1 bước cuối nữa như này được không hả thầy: Ví dụ cuối ngày sau khi thu được ở các T1, T2... một số khách hàng, em muốn chạy thêm một lệnh nữa để nhặt riêng các khách hàng này ra 1 sheet "KH DA NOP LAI" nữa ạ.
Nhấp chuột vào đây để mở rộng...
Chạy code riêng hay ghép với code trước?
Các "LDS" các sheet T1, T2 ... có trùng không? nếu trùng kết quả trình bày như thế nào?
 
HieuCD đã viết:
Chạy code riêng hay ghép với code trước?
Các "LDS" các sheet T1, T2 ... có trùng không? nếu trùng kết quả trình bày như thế nào?
Nhấp chuột vào đây để mở rộng...
Dạ em muốn chạy code riêng ạ. Vì sau khi chạy code tổng hợp thì còn thao tác chọn thu cho từng KH, kết thúc ngày giao dịch em mới chạy code nữa để nhặt các LDS đã thu và số tiền kèm theo. Các LDS ở các sheet không trùng nhau ạ.
 
hoangluongvinh đã viết:
Dạ em muốn chạy code riêng ạ. Vì sau khi chạy code tổng hợp thì còn thao tác chọn thu cho từng KH, kết thúc ngày giao dịch em mới chạy code nữa để nhặt các LDS đã thu và số tiền kèm theo. Các LDS ở các sheet không trùng nhau ạ.
Nhấp chuột vào đây để mở rộng...
Chạy code
Mã: 
Sub Danhsach()
  Dim sArr(), aKH(), Res(), LastR&, i&, sRow&, k&
 
  Application.ScreenUpdating = False
  Application.DisplayAlerts = False
  On Error Resume Next
 
  ReDim Res(1 To 10000, 1 To 6) ' toi da 10.000 dong ket qua
  For n = 1 To 12
      LastR = 0
      With Sheets("T" & n)
        LastR = .Range("D" & Rows.Count).End(xlUp).Row
        If LastR > 5 Then
          sArr = .Range("D6:H" & LastR).Value
          sRow = UBound(sArr)
          For i = 1 To sRow
            If sArr(i, 5) <> Empty Then
              k = k + 1
              Res(k, 1) = sArr(i, 1)
              Res(k, 5) = sArr(i, 2)
              Res(k, 6) = sArr(i, 5)
            End If
         Next i
        End If
      End With
  Next n
  With Sheets("DANH SACH DA NOP LAI")
    LastR = .Range("A" & Rows.Count).End(xlUp).Row
    If LastR > 2 Then .Range("A3:F" & LastR).ClearContents
    If k Then .Range("A3:F3").Resize(k) = Res
  End With
  Application.DisplayAlerts = False
  Application.ScreenUpdating = True
End Sub
 
hoangluongvinh đã viết:
Dạ em muốn chạy code riêng ạ. Vì sau khi chạy code tổng hợp thì còn thao tác chọn thu cho từng KH, kết thúc ngày giao dịch em mới chạy code nữa để nhặt các LDS đã thu và số tiền kèm theo. Các LDS ở các sheet không trùng nhau ạ.
Nhấp chuột vào đây để mở rộng...
Bạn làm quỹ tín dụng á
 
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

P
Unsurpassed Сasual Dating - Legitimate Girls
Trả lời
0
Đọc
13
pta289
P
kiencuong030184
  • Question
ẩn hiện dòng, cột có điều kiên
Trả lời
0
Đọc
12
kiencuong030184
kiencuong030184
A
[Góc giúp đỡ] Tìm kiếm, lọc và lấy dữ liệu từ nhiều file Word cấu trúc giống nhau vào 1 file excel mẫu
Trả lời
4
Đọc
95
Hoàng Tuấn 868
H
Emyeuexcel
  • Question
In theo số thứ tự
    • Chấp nhận
Trả lời
1
Đọc
35
VetMini
V
Emyeuexcel
In theo số thứ tự
Trả lời
2
Đọc
48
VetMini
V
Xem thêm…

Facebook

Giaiphapexcel.com

Group

DIỄN ĐÀN GIẢI PHÁP EXCEL Group 1
DIỄN ĐÀN GIẢI PHÁP EXCEL Group 2

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