Tổng hợp báo cáo dữ liệu từ nhiều file excel

Liên hệ QC
GTK-PM

GTK-PM

Thành viên thường trực
Tham gia
10/11/13
Bài viết
313
Được thích
15
Kính gửi: anh/ chị
Hiện tại em có 1 file báo cáo tổng hợp và các file excel dữ liệu được gửi về từ các đơn vị thành viên khác với khối lượng dữ liệu rất lớn, mà copy rồi paste rất mất thời gian. Nên em đưa file lên nhờ anh chị giúp đỡ.
File đính kèm: http://www.mediafire.com/file/2275b8cct4sx8ke/Doanh+thu+cong+trinh.rar
Nội dung:
+ Tìm kiếm cho File theo dõi doanh thu: Tại cột B,D,E,F,G,H,I,J,Q (bôi màu vàng), Lấy dữ liệu tại các sheet con tại các cột
"A12:A" cho cột B(file theo dõi doanh thu), "B12:B" cho cột D(file theo dõi doanh thu),"C12:C" cho cột E(file theo dõi doanh thu),"D12:D" cho cột F(file theo dõi doanh thu).
"E12:E" cho cột G(file theo dõi doanh thu)
Lưu ý: Nếu tên file bắt đầu: VT*** thì trả về cột G,NC*** trả về H, MM***trả về cột I, QL trả về cột J
Cuối cùng "G12:G" cho cột Q(file theo dõi doanh thu)
+ Sửa các hàm có sẵn tại sheet chi tiết tại file theo dõi doanh thu bằng code VBA để giảm dung lượng file.
Rất mong anh chị giúp đỡ !
 
Sắp xếp theo thời gian sắp xếp theo bầu chọn
Rất mong anh chị giúp đỡ. Hoặc sửa lại code này cho em với
Mã: 
Option Explicit
Sub import_data()
   
    Dim master As Worksheet, sh As Worksheet
    Dim wk As Workbook
    Dim strFolderPath As String
    Dim selectedFiles As Variant
    Dim iFileNum As Integer, iLastRowReport As Integer, iNumberOfRowsToPaste As Integer
    Dim strFileName As String
    Dim rID As Range, rQuantity As Range, rUnitPrice As Range, rKM As Range, rMC As Range
    Dim iCurrentLastRow As Integer, iRowStartToPaste As Integer
    Dim startTime As Double
   
   
    getSpeed (True)
    Set master = ActiveWorkbook.Sheets("Data")
   
    strFolderPath = ActiveWorkbook.Path
   
    ChDrive strFolderPath
    ChDir strFolderPath
   
    On Error GoTo NoFileSelected
    selectedFiles = Application.GetOpenFilename( _
                    filefilter:="Excel Files (*.xls*),*.xlsx*", MultiSelect:=True)
                   
    startTime = Timer
    For iFileNum = LBound(selectedFiles) To UBound(selectedFiles)
        strFileName = selectedFiles(iFileNum)
       
        Set wk = Workbooks.Open(strFileName)
        For Each sh In wk.Sheets
            If sh.Name Like "*-REPORT" Then
                With sh
                    iLastRowReport = .Range("A" & Rows.Count).End(xlUp).Row
                    iNumberOfRowsToPaste = iLastRowReport - 6 + 1
                   
                    Set rID = .Range("A6:A" & iLastRowReport)
                    Set rQuantity = .Range("C6:C" & iLastRowReport)
                    Set rUnitPrice = .Range("F6:F" & iLastRowReport)
                    Set rKM = .Range("I6:I" & iLastRowReport)
                    Set rMC = .Range("K6:K" & iLastRowReport)
                   
                    With master
                        iCurrentLastRow = .Range("A" & Rows.Count).End(xlUp).Row
                        iRowStartToPaste = iCurrentLastRow + 1
                       
                        .Range("A" & iRowStartToPaste).Resize(iNumberOfRowsToPaste, 1) = rID.Value2
                        .Range("C" & iRowStartToPaste).Resize(iNumberOfRowsToPaste, 1) = rQuantity.Value2
                        .Range("E" & iRowStartToPaste).Resize(iNumberOfRowsToPaste, 1) = rUnitPrice.Value2
                        .Range("G" & iRowStartToPaste).Resize(iNumberOfRowsToPaste, 1) = rKM.Value2
                        .Range("I" & iRowStartToPaste).Resize(iNumberOfRowsToPaste, 1) = rMC.Value2
                    End With
                   
                End With
            End If
        Next sh
        wk.Close
    Next
   
    MsgBox "Done in " & Int(Timer - startTime) & " s."
    getSpeed (False)
NoFileSelected:
    MsgBox "Chua co file nao duoc chon!"
End Sub

Function getSpeed(doIt As Boolean)
    Application.ScreenUpdating = Not (doIt)
    Application.EnableEvents = Not (doIt)
    Application.Calculation = IIf(doIt, xlCalculationManual, xlCalculationAutomatic)
End Function
 
Upvote 0
aicungyeuanh đã viết:
Rất mong anh chị giúp đỡ. Hoặc sửa lại code này cho em với
Mã: 
Option Explicit
Sub import_data()
  
    Dim master As Worksheet, sh As Worksheet
    Dim wk As Workbook
    Dim strFolderPath As String
    Dim selectedFiles As Variant
    Dim iFileNum As Integer, iLastRowReport As Integer, iNumberOfRowsToPaste As Integer
    Dim strFileName As String
    Dim rID As Range, rQuantity As Range, rUnitPrice As Range, rKM As Range, rMC As Range
    Dim iCurrentLastRow As Integer, iRowStartToPaste As Integer
    Dim startTime As Double
  
  
    getSpeed (True)
    Set master = ActiveWorkbook.Sheets("Data")
  
    strFolderPath = ActiveWorkbook.Path
  
    ChDrive strFolderPath
    ChDir strFolderPath
  
    On Error GoTo NoFileSelected
    selectedFiles = Application.GetOpenFilename( _
                    filefilter:="Excel Files (*.xls*),*.xlsx*", MultiSelect:=True)
                  
    startTime = Timer
    For iFileNum = LBound(selectedFiles) To UBound(selectedFiles)
        strFileName = selectedFiles(iFileNum)
      
        Set wk = Workbooks.Open(strFileName)
        For Each sh In wk.Sheets
            If sh.Name Like "*-REPORT" Then
                With sh
                    iLastRowReport = .Range("A" & Rows.Count).End(xlUp).Row
                    iNumberOfRowsToPaste = iLastRowReport - 6 + 1
                  
                    Set rID = .Range("A6:A" & iLastRowReport)
                    Set rQuantity = .Range("C6:C" & iLastRowReport)
                    Set rUnitPrice = .Range("F6:F" & iLastRowReport)
                    Set rKM = .Range("I6:I" & iLastRowReport)
                    Set rMC = .Range("K6:K" & iLastRowReport)
                  
                    With master
                        iCurrentLastRow = .Range("A" & Rows.Count).End(xlUp).Row
                        iRowStartToPaste = iCurrentLastRow + 1
                      
                        .Range("A" & iRowStartToPaste).Resize(iNumberOfRowsToPaste, 1) = rID.Value2
                        .Range("C" & iRowStartToPaste).Resize(iNumberOfRowsToPaste, 1) = rQuantity.Value2
                        .Range("E" & iRowStartToPaste).Resize(iNumberOfRowsToPaste, 1) = rUnitPrice.Value2
                        .Range("G" & iRowStartToPaste).Resize(iNumberOfRowsToPaste, 1) = rKM.Value2
                        .Range("I" & iRowStartToPaste).Resize(iNumberOfRowsToPaste, 1) = rMC.Value2
                    End With
                  
                End With
            End If
        Next sh
        wk.Close
    Next
  
    MsgBox "Done in " & Int(Timer - startTime) & " s."
    getSpeed (False)
NoFileSelected:
    MsgBox "Chua co file nao duoc chon!"
End Sub

Function getSpeed(doIt As Boolean)
    Application.ScreenUpdating = Not (doIt)
    Application.EnableEvents = Not (doIt)
    Application.Calculation = IIf(doIt, xlCalculationManual, xlCalculationAutomatic)
End Function
Nhấp chuột vào đây để mở rộng...
Bạn download file theo đường dẫn: http://www.mediafire.com/file/8r47blwn8dbm915/Doanh+thu+cong+trinh.rar
Bạn lưu ý:
- Đối với các file dữ liệu đầu vào, không được sử dụng merge cell. Mình đã sửa lại mẫu của bạn rồi, từ sau cứ làm như vậy.
- Đối với sheet Bang ma cac cong trinh, bạn phải thiết lập đầy đủ
Có gì bạn cứ trao đổi nếu cần sửa chữa.
 
Upvote 0
Chân thành cảm ơn bạn, mình đang theo dõi. Nếu có gì phát sinh mình sẽ hỏi thêm ý kiến của bạn.
P/s: Hình như phiên bản diễn đàn mới ít người comment hơn thì phải. !!!
 
Upvote 0
vanthinh3101 đã viết:
Bạn download file theo đường dẫn: http://www.mediafire.com/file/8r47blwn8dbm915/Doanh+thu+cong+trinh.rar
Bạn lưu ý:
- Đối với các file dữ liệu đầu vào, không được sử dụng merge cell. Mình đã sửa lại mẫu của bạn rồi, từ sau cứ làm như vậy.
- Đối với sheet Bang ma cac cong trinh, bạn phải thiết lập đầy đủ
Có gì bạn cứ trao đổi nếu cần sửa chữa.
Nhấp chuột vào đây để mở rộng...
Bạn kiểm tra giúp mình tại cột C sheet Nhap lieu chỉ tìm kiếm mã công trình đến C35 mà Bang ma cac cong trinh mình đã thiết lập đầy đủ rồi
 
Upvote 0
+ Bạn kiểm tra giúp mình tại cột C sheet Nhaplieu chỉ tìm kiếm mã công trình đến hàng C35 mà Bang ma cac cong trinh mình đã thiết lập đầy đủ rồi.
+ Tại sheet " Chi tiết " bạn cho mình code tự ẩn hàng, khi có trống dữ liệu.
Ví dụ: Dữ liệu vlookup tìm tại D6 tìm kiếm được dữ liệu đến hàng 40 của bảng tính. Điều kiện mình muốn là ẩn hết từ hàng 41 đến hàng 500. Dạng code bên dưới, nhưng mình không thể triển khai được vào sheet Chi tiết
Mã: 
 Next I
    .Rows("12:500").Hidden = False
    .Range("B12:J500").ClearContents
    If K Then .Range("B12").Resize(K, 9) = dArr
    .Rows(K + 12 & ":500").Hidden = True
 
Upvote 0
Rất mong nhận được hồi âm của các bạn
 
Upvote 0
+ Bạn kiểm tra giúp mình tại cột C sheet Nhaplieu chỉ tìm kiếm mã công trình đến hàng C35 mà Bang ma cac cong trinh mình đã thiết lập đầy đủ rồi.
+ Tại sheet " Chi tiết " bạn cho mình code tự ẩn hàng, khi có trống dữ liệu.
+ Và giảm dung lượng file Excel bằng code VBA tìm kiếm tại sheet " Chi tiet " thay hàm, công thức.
Ví dụ: Dữ liệu vlookup tìm tại D6 tìm kiếm được dữ liệu đến hàng 40 của bảng tính. Điều kiện mình muốn là ẩn hết từ hàng 41 đến hàng 500. Dạng code bên dưới, nhưng mình không thể triển khai được vào sheet Chi tiết
 
Upvote 0
Chả ai giúp đỡ mình vậy:((
 
Upvote 0
aicungyeuanh đã viết:
http://www.mediafire.com/file/8r47blwn8dbm915/Doanh+thu+cong+trinh.rar File đính kèm
Nhấp chuột vào đây để mở rộng...
1/ Việc gộp File của bạn cần phải thiết kế lại tiêu đề File Theo doi doanh thu chi phi cho phù hợp với các File chi tiết.

2/ Thêm một cái nữa là làm sao lấy tên File của từng người gán vào một cột (để phân biệt dữ liệu nào của File nào), rồi mới tính đến chuyện lấy dữ liệu vào các sheet khác (cái này chờ nghiên cứu sau), chứ hiện tại tôi chưa có giải pháp.
 
Upvote 0
Vậy còn 2 vấn đề này, rất mong bạn tạo giúp mình code
+ Tại sheet " Chi tiết " bạn cho mình code tự ẩn hàng, khi ô bị trống dữ liệu.
+ Và giảm dung lượng file Excel bằng code VBA tìm kiếm tại sheet " Chi tiet " để thay các hàm, công thức trong bảng tính.
Ví dụ: Dữ liệu vlookup tìm tại D6 tìm kiếm được dữ liệu đến hàng 40 của bảng tính. Điều kiện mình muốn là ẩn hết từ hàng 41 đến hàng 500. Dạng code bên dưới, nhưng mình không thể triển khai được vào sheet Chi tiết
 
Upvote 0
aicungyeuanh đã viết:
Chả ai giúp đỡ mình vậy:((
Nhấp chuột vào đây để mở rộng...
Tôi đã sửa lại mẫu và code 1 chút:
- Thêm 1 cột Tên nhà cung cấp sau cột Tên công trình theo như gợi ý của bác be09. Để kết quả được chính xác, đối với các file dữ liệu đầu vào, bạn phải đặt tên sheet chính xác theo tên nhà cung cấp.
- Sửa code để tránh bị lỗi khi đối chiếu tên công trình với mã công trình. Trường hợp mã công trình ra kết quả "blank" thì bạn xem lại dữ liệu đầu vào, tên công trình có thể bị sai sót (có thể là 2 khoảng trắng liên tiếp chẳng hạn)
@be09 cảm ơn bác đã gợi ý để giải pháp được hoàn thiện hơn
 

File đính kèm

  • Theo doi doanh thu chi phi.xlsm
    261.2 KB · Đọc: 25
Upvote 0
vanthinh3101 đã viết:
Tôi đã sửa lại mẫu và code 1 chút:
- Thêm 1 cột Tên nhà cung cấp sau cột Tên công trình theo như gợi ý của bác be09. Để kết quả được chính xác, đối với các file dữ liệu đầu vào, bạn phải đặt tên sheet chính xác theo tên nhà cung cấp.
- Sửa code để tránh bị lỗi khi đối chiếu tên công trình với mã công trình. Trường hợp mã công trình ra kết quả "blank" thì bạn xem lại dữ liệu đầu vào, tên công trình có thể bị sai sót (có thể là 2 khoảng trắng liên tiếp chẳng hạn)
@be09 cảm ơn bác đã gợi ý để giải pháp được hoàn thiện hơn
Nhấp chuột vào đây để mở rộng...
Vậy còn 2 vấn đề này, rất mong bạn tạo giúp mình code
+ Tại sheet " Chi tiết " bạn cho mình code tự ẩn hàng, khi ô bị trống dữ liệu.
+ Và giảm dung lượng file Excel bằng code VBA tìm kiếm tại sheet " Chi tiet " để thay các hàm, công thức trong bảng tính.
Ví dụ: Dữ liệu vlookup tìm tại D6 tìm kiếm được dữ liệu đến hàng 40 của bảng tính. Điều kiện mình muốn là ẩn hết từ hàng 41 đến hàng 500. Dạng code bên dưới, nhưng mình không thể triển khai được vào sheet Chi tiết
 
Upvote 0
aicungyeuanh đã viết:
Vậy còn 2 vấn đề này, rất mong bạn tạo giúp mình code
+ Tại sheet " Chi tiết " bạn cho mình code tự ẩn hàng, khi ô bị trống dữ liệu.
+ Và giảm dung lượng file Excel bằng code VBA tìm kiếm tại sheet " Chi tiet " để thay các hàm, công thức trong bảng tính.
Ví dụ: Dữ liệu vlookup tìm tại D6 tìm kiếm được dữ liệu đến hàng 40 của bảng tính. Điều kiện mình muốn là ẩn hết từ hàng 41 đến hàng 500. Dạng code bên dưới, nhưng mình không thể triển khai được vào sheet Chi tiết
Nhấp chuột vào đây để mở rộng...
Mình đã sửa thêm rồi:
- Tại sheet "Chi tiet", mình đã sửa lại Data validation ở ô D6 theo Mã công trình ở sheet "Bang ma cong trinh";
- Sau khi tổng hợp thông tin ở sheet "Nhap lieu" --> sang sheet "Chi tiet" --> chọn Mã công trình ở ô D6 --> click vào Button ở góc trên cùng bên trái --> toàn bộ số liệu liên quan đến công trình tại ô D6 sẽ được hiện ra, các dòng trống cũng sẽ tự động ẩn.
Những vấn đề còn lại về công thức mình thấy không phức tạp, bạn có thể tự giải quyết được.
 

File đính kèm

  • Theo doi doanh thu chi phi.xlsm
    239.4 KB · Đọc: 20
Upvote 0
vanthinh3101 đã viết:
Mình đã sửa thêm rồi:
- Tại sheet "Chi tiet", mình đã sửa lại Data validation ở ô D6 theo Mã công trình ở sheet "Bang ma cong trinh";
- Sau khi tổng hợp thông tin ở sheet "Nhap lieu" --> sang sheet "Chi tiet" --> chọn Mã công trình ở ô D6 --> click vào Button ở góc trên cùng bên trái --> toàn bộ số liệu liên quan đến công trình tại ô D6 sẽ được hiện ra, các dòng trống cũng sẽ tự động ẩn.
Những vấn đề còn lại về công thức mình thấy không phức tạp, bạn có thể tự giải quyết được.
Nhấp chuột vào đây để mở rộng...
Đúng mọi vấn đề như mình mong muốn, chân thành cảm ơn bạn.
 
Upvote 0
vanthinh3101 đã viết:
Mình đã sửa thêm rồi:
- Tại sheet "Chi tiet", mình đã sửa lại Data validation ở ô D6 theo Mã công trình ở sheet "Bang ma cong trinh";
- Sau khi tổng hợp thông tin ở sheet "Nhap lieu" --> sang sheet "Chi tiet" --> chọn Mã công trình ở ô D6 --> click vào Button ở góc trên cùng bên trái --> toàn bộ số liệu liên quan đến công trình tại ô D6 sẽ được hiện ra, các dòng trống cũng sẽ tự động ẩn.
Những vấn đề còn lại về công thức mình thấy không phức tạp, bạn có thể tự giải quyết được.
Nhấp chuột vào đây để mở rộng...
vanthinh3110 ơi: Hiện tại về cấu trúc code là đúng, nhưng nếu nhấn vào chữ click để xem nội dung tại mã công trình D6 thì đều bị ẩn như thế này !
 

File đính kèm

  • anhang.jpg
    anhang.jpg
    147.3 KB · Đọc: 9
Upvote 0
aicungyeuanh đã viết:
vanthinh3110 ơi: Hiện tại về cấu trúc code là đúng, nhưng nếu nhấn vào chữ click để xem nội dung tại mã công trình D6 thì đều bị ẩn như thế này !
Nhấp chuột vào đây để mở rộng...
Vấn đề này do thông tin đầu vào.
Mình không có những thông tin chi tiết nên không link được.
Bạn xem lại dữ liệu đầu vào để sửa lại công thức cho chính xác nhé!
Mẫu này mình làm trong điều kiện hạn chế thông tin mà.
 
Upvote 0
vanthinh3101 đã viết:
Vấn đề này do thông tin đầu vào.
Mình không có những thông tin chi tiết nên không link được.
Bạn xem lại dữ liệu đầu vào để sửa lại công thức cho chính xác nhé!
Mẫu này mình làm trong điều kiện hạn chế thông tin mà.
Nhấp chuột vào đây để mở rộng...
Link cần sửa: http://www.mediafire.com/file/l4beyitorq62kni/Doanh+thu+cong+trinh+can+sua.rar
Bạn thử lặp đi lặp lại nút click để tìm kiếm dữ liệu theo mã công trình, thì sẽ chỉ hiển thị tổng tiền và ẩn mất phần chi tiết.
 
Upvote 0
Vấn đề này mình nghĩ là code có thể "hide" vào nhưng chưa có đoạn "unhide" để tự động hiện ẩn hàng ra khi có dữ liệu.
 
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

tby211
Lỗi 1004 vba khi tách file trắc nghiệm sang excel
Trả lời
0
Đọc
11
tby211
tby211
NguyenthiH
  • Question
Code lấy dữ liệu cho sheet!TonDau.
Trả lời
6
Đọc
136
NguyenthiH
NguyenthiH
test1986
  • Question
HELP! Sử dụng combobox để cập nhật dữ liệu trong file Excel
Trả lời
17
Đọc
505
ngochienbmt
N
N
Hàm if, lọc dữ liệu trùng
Trả lời
6
Đọc
6K
OANHMAI123
O
T
Xóa dòng theo điều kiện
Trả lời
1
Đọc
50
SA_DQ
SA_DQ
Xem thêm…

Facebook

Giaiphapexcel.com

Group

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

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