Xin hỗ trợ VBA tổng hợp số liệu từ nhiều sheet

nmdong.dbi

Thành viên mới
Tham gia ngày
8 Tháng chín 2020
Bài viết
10
Được thích
0
Điểm
13
Tuổi
51
Hiện tại mình đang có rất nhiều file dữ liệu cần tổng hợp chung vào 1 file excel. Mỗi file excel lẻ có 16 sheet. Nhưng thực tế mình chỉ sử dụng số liệu ở sheet 1,2,3,4 ( tương ứng với số liệu của 4 quý trong năm )
Mình đã có code để ghép nhiều file excel vào thành 1 file và code để xóa các sheet ko dùng đến.
Vấn đề đặt ra bây giờ là: Sau khi đã ghép file xong mình làm cách nào để tổng hợp được số liệu của cột N ở tất cả các sheet chứa dữ liệu ào cột D với MST tương ứng của sheet có tên TH
Em đang tính làm theo cách tổng hợp số liệu ở tất cả các sheet vào sheet có tên DATA với MST tương ứng để dùng hàm sumif tính tổng cho từng MST sang sheet TH
Bác nào có thể giúp em hoàn thiện được không ạ? Em cảm ơn các bác !
 

File đính kèm

Nhattanktnn

Thành viên tích cực
Tham gia ngày
11 Tháng mười một 2016
Bài viết
836
Được thích
798
Điểm
360
Hiện tại mình đang có rất nhiều file dữ liệu cần tổng hợp chung vào 1 file excel. Mỗi file excel lẻ có 16 sheet. Nhưng thực tế mình chỉ sử dụng số liệu ở sheet 1,2,3,4 ( tương ứng với số liệu của 4 quý trong năm )
Mình đã có code để ghép nhiều file excel vào thành 1 file và code để xóa các sheet ko dùng đến.
Vấn đề đặt ra bây giờ là: Sau khi đã ghép file xong mình làm cách nào để tổng hợp được số liệu của cột N ở tất cả các sheet chứa dữ liệu ào cột D với MST tương ứng của sheet có tên TH
Em đang tính làm theo cách tổng hợp số liệu ở tất cả các sheet vào sheet có tên DATA với MST tương ứng để dùng hàm sumif tính tổng cho từng MST sang sheet TH
Bác nào có thể giúp em hoàn thiện được không ạ? Em cảm ơn các bác !
Bạn xem thử:
PHP:
Sub TongCong()
Dim sArr(), Res(), Ws As Worksheet, Lr As Long, RngSum As Range, Txt1 As String, Txt2 As String
Application.ScreenUpdating = False
With Sheets("TH")
    Lr = .Range("B" & Rows.Count).End(xlUp).Row
         .Range("D9:D" & Lr).ClearContents
    sArr = .Range("B9:B" & Lr).Value
End With
ReDim Res(1 To UBound(sArr), 1 To 1)
For i = 1 To UBound(sArr, 1)
    Txt1 = sArr(i, 1)
    For Each Ws In ActiveWorkbook.Worksheets
        If InStr(Ws.Name, "Sheet") > 0 Then
            Txt2 = Ws.Range("D9").Value
            If Txt1 = Txt2 Then
                Set RngSum = Ws.Range("N18:N" & Ws.Range("N" & Rows.Count).End(xlUp).Row)
                Res(i, 1) = Res(i, 1) + Application.WorksheetFunction.Sum(RngSum)
            End If
        End If
    Next
Next
Sheets("TH").Range("D9").Resize(UBound(sArr, 1), 1) = Res
Application.ScreenUpdating = True
End Sub
 
Lần chỉnh sửa cuối:

nmdong.dbi

Thành viên mới
Tham gia ngày
8 Tháng chín 2020
Bài viết
10
Được thích
0
Điểm
13
Tuổi
51
Bạn xem thử:
....
Dạ đúng chuẩn luôn rồi ạ. Em cảm ơn bác nhiều lắm ạ.
Em muốn nhờ thêm 1 chút xíu là em có code ghép các sheet từ nhiều file excel như thế này. Giờ khi ghép em chỉ muốn ghép các sheet 1,2,3,4 của file đó vào file tổng hợp thôi thì làm như thế nào ạ? Em cảm ơn bác

Sub copyfile()
Path = ""
Filename = Dir(Path & "*.xls*")
Do While Filename <> ""
Workbooks.Open Filename:=Path & Filename, ReadOnly:=True
For Each Sheet In ActiveWorkbook.Sheets
Sheet.Copy After:=ThisWorkbook.Sheets(1)
Next
Workbooks(Filename).Close
Filename = Dir()
Loop
End Sub
 

Nhattanktnn

Thành viên tích cực
Tham gia ngày
11 Tháng mười một 2016
Bài viết
836
Được thích
798
Điểm
360
sửa dòng này nè bạn:
PHP:
For Each Sheet In ActiveWorkbook.Sheets(Array("Sheet1", "Sheet2", "Sheet3", "Sheet4"))
 

Nhattanktnn

Thành viên tích cực
Tham gia ngày
11 Tháng mười một 2016
Bài viết
836
Được thích
798
Điểm
360
Yêu bác quá luôn ạ ! Thank so much !
Bạn thử chưa
Bài đã được tự động gộp:

Hoặc bạn có thể thử sub này để copy file (có thể chọn folder tùy ý, và có thể đặt file chính chung folder):
PHP:
Sub Copy_File()
Application.ScreenUpdating = False
Dim MainWB As Workbook, Ws As Worksheet, SubWB As Workbook, sFile As Object, Fso As Object, Chk As Boolean, Fpath As String, SheetArr()
Set MainWB = ThisWorkbook
Set Fso = CreateObject("Scripting.FileSystemObject")
With Application.FileDialog(msoFileDialogFolderPicker)
    Chk = .Show
    If Not Chk Then Exit Sub
    Fpath = .SelectedItems(1)
End With
For Each sFile In Fso.getfolder(Fpath).Files
    If Fso.GetExtensionName(sFile) Like "xls*" And InStr(MainWB.Name, Fso.getbasename(sFile)) = 0 And InStr(Fso.getbasename(sFile), "~$") = 0 Then
        Workbooks.Open sFile
        Set SubWB = ActiveWorkbook
        SheetArr = Array("Sheet1", "Sheet2", "Sheet3", "Sheet4")
            For Each Ws In SubWB.Sheets(SheetArr)
                Ws.Copy after:=MainWB.Sheets(MainWB.Sheets.Count)
            Next
        SubWB.Close False
    End If
Next
Set Fso = Nothing
Application.ScreenUpdating = True
End Sub
 
Lần chỉnh sửa cuối:

nmdong.dbi

Thành viên mới
Tham gia ngày
8 Tháng chín 2020
Bài viết
10
Được thích
0
Điểm
13
Tuổi
51
Bạn thử chưa
Bài đã được tự động gộp:

Hoặc bạn có thể thử sub này để copy file (có thể chọn folder tùy ý, và có thể đặt file chính chung folder):
.....

Dạ em test thử được ngon luôn rồi bác. Cảm ơn bác đã tận tình nhiều lắm luôn ạ !
Bài đã được tự động gộp:

Code của bác cho xịn xò hơn ạ. Hiện lên cửa sổ để mình chọn foder chứa file.
Em muốn hỏi thêm một chút là em đang dùng code để xóa hết các sheet hoặc tùy chọn. Giờ em muốn sửa code thành chỉ để lại sheet có tên TH và RUN còn lại các sheet khác xóa hết thì làm ntn ạ bác ?

Sub XoaSheets()
Dim Ws As Worksheet, i As Long, tmp, tmp1
tmp = MsgBox("Chon Yes neu Xoa tat ca cac Sheet" & vbCr & _
"Chon No neu chi Xoa cac sheet duoc chon" _
, vbYesNo, "WARNING: Delete All sheets in workbook")


If tmp = vbYes Then tmp1 = MsgBox("Chon Yes neu thuc su Delete tat ca cac Sheet" & vbCr & _
"Chon No neu huy lenh Delete" _
, vbYesNo, "WARNING: Sheets Delete không the khoi phuc!!!")
If tmp1 = vbNo Then Exit Sub


Application.DisplayAlerts = False
Application.ScreenUpdating = False
For Each Ws In Worksheets
If Ws.Name <> ActiveSheet.Name Then
If tmp = vbYes Then
Ws.Delete
Else
tmp1 = MsgBox("Chon Yes neu thuc su Delete Sheet : " & Ws.Name & vbCr & _
"Chon No neu khong muon Delete Sheet: " & Ws.Name _
, vbYesNo, "WARNING: Sheets Delete không the khoi phuc!!!")
If tmp1 = vbYes Then
Ws.Delete
End If
End If
End If
Next Ws
Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Sub
 
Lần chỉnh sửa cuối:

Nhattanktnn

Thành viên tích cực
Tham gia ngày
11 Tháng mười một 2016
Bài viết
836
Được thích
798
Điểm
360
For Each Ws In Worksheets
If Ws.Name <> ActiveSheet.Name Then
Thử sửa chỗ này thành:
PHP:
For Each Ws In Worksheets
If Ws.Name <> ActiveSheet.Name and  Ws.Name <> "TH" Then
Bài đã được tự động gộp:

Mà nó chỉ cần ngắn gọn thế này thôi:
PHP:
Sub XoaSheets()
Dim ws As Worksheet, tmp As Variant
Application.DisplayAlerts = False
Application.ScreenUpdating = False
tmp = MsgBox("Ten sheet khac " & Chr(34) & "TH" & Chr(34) & " va " & Chr(34) & "RUN" & Chr(34) & " se bi xoa" _
, vbYesNo, "WARNING:   Xoa sheet")
If tmp = vbNo Then Exit Sub
    For Each ws In Worksheets
        If ws.Name <> "RUN" And ws.Name <> "TH" Then
                ws.Delete
        End If
    Next ws
Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Sub
 
Lần chỉnh sửa cuối:

nmdong.dbi

Thành viên mới
Tham gia ngày
8 Tháng chín 2020
Bài viết
10
Được thích
0
Điểm
13
Tuổi
51
......
Da Dạ em vừa test thử rồi ạ. Code của bác đúng cái em muốn luôn. Xóa hết chỉ giữ lại TH và RUN. Em cảm ơn bác nhiều lắm ạ !
 

nmdong.dbi

Thành viên mới
Tham gia ngày
8 Tháng chín 2020
Bài viết
10
Được thích
0
Điểm
13
Tuổi
51
Dạ vâng ạ. Em cũng mới tìm hiểu về VBA nên cũng nhiều cái chưa biết lắm. Cũng quên mất là trên diễn đàn mình cũng có nhiều bài viết có nội dung liên quan rồi. Lần tới em sẽ cố gắng tìm trước khi hỏi ạ. Hihi. Gặp cao thủ như bác thì vấn đề được giải quyết nhanh hơn ạ
Bài đã được tự động gộp:

Mà đề này phát sinh hơi nhiều đó nhá :D
Dạ vâng ạ. Em cũng mới tìm hiểu về VBA nên cũng nhiều cái chưa biết lắm. Cũng quên mất là trên diễn đàn mình cũng có nhiều bài viết có nội dung liên quan rồi. Lần tới em sẽ cố gắng tìm trước khi hỏi ạ. Hihi. Gặp cao thủ như bác thì vấn đề được giải quyết nhanh hơn ạ
 

nmdong.dbi

Thành viên mới
Tham gia ngày
8 Tháng chín 2020
Bài viết
10
Được thích
0
Điểm
13
Tuổi
51
Mà đề này phát sinh hơi nhiều đó nhá :D
Dạ em xin phép được nhờ bác một lần nữa ạ.
Hiện tại em đang cần lấy dữ liệu từ website chạy trên nền IE.
Em có một file Excel có sẵn điều kiện để nhập vào web như MST(cộtB) và các dữ liệu điều kiện khác (cột D,E,F,G).
Sau khi nhập web xong web sẽ cho kết xuất file và em muốn lưu file đó vào một tệp bất kỳ do mình lựa chọn
Em gửi báo hình ảnh và mô tả xem có Code VBA nào khả thi không ạ. Em cảm ơn bác.
 

File đính kèm

Nhattanktnn

Thành viên tích cực
Tham gia ngày
11 Tháng mười một 2016
Bài viết
836
Được thích
798
Điểm
360
Dạ em xin phép được nhờ bác một lần nữa ạ.
Hiện tại em đang cần lấy dữ liệu từ website chạy trên nền IE.
Em có một file Excel có sẵn điều kiện để nhập vào web như MST(cộtB) và các dữ liệu điều kiện khác (cột D,E,F,G).
Sau khi nhập web xong web sẽ cho kết xuất file và em muốn lưu file đó vào một tệp bất kỳ do mình lựa chọn
Em gửi báo hình ảnh và mô tả xem có Code VBA nào khả thi không ạ. Em cảm ơn bác.
Cũng muốn giúp bạn nhưng khả năng của mình hạn hẹp, bạn đăng bài mới và nói rõ mục đích để được các bác trên diễn đàn giúp đỡ nhé!
 
Top Bottom