Em xin được sự giúp đỡ cộng dữ liệu các file có cấu trúc tương tự

Bùi Thúy Thúy

Thành viên thường trực
Tham gia ngày
2 Tháng bảy 2018
Bài viết
287
Được thích
35
Điểm
185
Tuổi
32
Em có 10 file có tên từ “file so 01” đến “file so 10”

Trong mỗi file đều có 01 sheet, trong sheet đó có 02 cột dữ liệu ở cột Acột B

Bài toán đặt ra: Muốn gộp tất cả các file từ “file so 01 “ đến “file so 10” thành 1 file duy nhất (file A) Trong file duy nhất đó chứa 10 sheet

Sau đó em muốn cộng tất cả các sheet của file đã được gộp (file A) thành 1 sheet duy nhất, sheet duy nhất này có cầu trúc tương tự như các sheet con, sheet duy nhất gồm cột A và cột B

Cột A để so sánh, đối chiếu (giống như tên mặt hàng, nhưng trong này em điền là số )

Cột B là cộng giá trị được gộp lại khi mang cột A ra để đối chiếu (Cột B giống như số tiền của tên mặt hàng trong cột A)

PASS: (Tóm lại : em muốn cộng dữ liệu của cột B trong tất cả các file từ “file so 01” đến “file số 10”, khi lấy dữ liệu cột A mang ra để đối chiếu)

Em xin cám ơn!anh 1.png
 

File đính kèm

Nhất Chi Lan

Thành viên mới
Tham gia ngày
3 Tháng mười hai 2018
Bài viết
95
Được thích
124
Điểm
180
Tuổi
24
Em muốn tổng hợp dữ liệu các file trong 1 thư mục và tính tổng các mã trùng vào trang tính ạ. Chị xem giúp em vớ ạ
 

File đính kèm

Bùi Thúy Thúy

Thành viên thường trực
Tham gia ngày
2 Tháng bảy 2018
Bài viết
287
Được thích
35
Điểm
185
Tuổi
32
Em muốn tổng hợp dữ liệu các file trong 1 thư mục và tính tổng các mã trùng vào trang tính ạ. Chị xem giúp em vớ ạ
Dạ em cám ơn, nhưng sử dụng thế nào ạ! nếu làm từng với file một sẽ báo lỗi ạ!
Chị nói rõ hơn chút được không ạ!
 

snow25

Thành viên gắn bó
Tham gia ngày
24 Tháng bảy 2018
Bài viết
2,351
Được thích
2,179
Điểm
360
Em có 10 file có tên từ “file so 01” đến “file so 10”

Trong mỗi file đều có 01 sheet, trong sheet đó có 02 cột dữ liệu ở cột Acột B

Bài toán đặt ra: Muốn gộp tất cả các file từ “file so 01 “ đến “file so 10” thành 1 file duy nhất (file A) Trong file duy nhất đó chứa 10 sheet

Sau đó em muốn cộng tất cả các sheet của file đã được gộp (file A) thành 1 sheet duy nhất, sheet duy nhất này có cầu trúc tương tự như các sheet con, sheet duy nhất gồm cột A và cột B

Cột A để so sánh, đối chiếu (giống như tên mặt hàng, nhưng trong này em điền là số )

Cột B là cộng giá trị được gộp lại khi mang cột A ra để đối chiếu (Cột B giống như số tiền của tên mặt hàng trong cột A)

PASS: (Tóm lại : em muốn cộng dữ liệu của cột B trong tất cả các file từ “file so 01” đến “file số 10”, khi lấy dữ liệu cột A mang ra để đối chiếu)

Em xin cám ơn!View attachment 208679
Bạn xem.
Mã:
Sub tonghopdulieu()
    Dim a As Long, b As Long, c As Long, d As Long, i As Long, j As Long
    Dim arr, arr1
    Dim dic As Object
    Dim ws As Worksheet
    Dim tong, k
    Dim wb As Workbook
    Dim sh As Worksheet
    Dim s As String
    Application.ScreenUpdating = False      'Loai bo nhay man hinh
    Application.DisplayAlerts = False       'Loai bo canh bao
    Application.AskToUpdateLinks = False    'Loai bo man hinh hoi update
    Set dic = CreateObject("scripting.dictionary")
    For Each sh In ThisWorkbook.Sheets
      If sh.Name <> "Filetong" Then
        sh.Delete
      End If
    Next
    Set tong = ThisWorkbook.Sheets("Filetong")
    With Application.FileDialog(msoFileDialogFilePicker) 'chon file
           .AllowMultiSelect = True 'cho phep chon nhieu file
    If Not .Show = -1 Then
          MsgBox ("khong chon file nao"), vbCritical, "KK"
          Application.ScreenUpdating = True
          Application.DisplayAlerts = True
          Application.AskToUpdateLinks = True
          Exit Sub
    End If
    ReDim arr1(1 To Rows.Count, 1 To 2)
    For Each k In .SelectedItems
      Set wb = Workbooks.Open(k)
        b = wb.Sheets(1).Range("a" & Rows.Count).End(xlUp).Row
        If b > 4 Then
           arr = wb.Sheets(1).Range("A1:B" & b).Value
           s = wb.Name
           For i = 5 To UBound(arr, 1)
                If dic.exists(arr(i, 1)) = 0 Then
                    a = a + 1
                   dic.Item(arr(i, 1)) = Array(a)
                   arr1(a, 1) = arr(i, 1)
                   arr1(a, 2) = arr(i, 2)
                Else
                   c = dic.Item(arr(i, 1))(0)
                   arr1(c, 2) = arr1(c, 2) + arr(i, 2)
                End If
           Next i
         wb.Close False
         Set ws = Worksheets.Add(, Sheets(1))
             ws.Name = s
             ws.Range("A1").Resize(UBound(arr, 1), 2).Value = arr
             Erase arr
       Else
          wb.Close False
       End If
    Next
    End With
    tong.Range("a5").Resize(Rows.Count - 10, 2).ClearContents
    tong.Range("a5").Resize(a, 2) = arr1
    Set dic = Nothing
    Application.ScreenUpdating = True
    Application.DisplayAlerts = True
    Application.AskToUpdateLinks = True
End Sub
 

File đính kèm

Bùi Thúy Thúy

Thành viên thường trực
Tham gia ngày
2 Tháng bảy 2018
Bài viết
287
Được thích
35
Điểm
185
Tuổi
32
Bạn xem.
Mã:
Sub tonghopdulieu()
    Dim a As Long, b As Long, c As Long, d As Long, i As Long, j As Long
    Dim arr, arr1
    Dim dic As Object
    Dim ws As Worksheet
    Dim tong, k
    Dim wb As Workbook
    Dim sh As Worksheet
    Dim s As String
    Application.ScreenUpdating = False      'Loai bo nhay man hinh
    Application.DisplayAlerts = False       'Loai bo canh bao
    Application.AskToUpdateLinks = False    'Loai bo man hinh hoi update
    Set dic = CreateObject("scripting.dictionary")
    For Each sh In ThisWorkbook.Sheets
      If sh.Name <> "Filetong" Then
        sh.Delete
      End If
    Next
    Set tong = ThisWorkbook.Sheets("Filetong")
    With Application.FileDialog(msoFileDialogFilePicker) 'chon file
           .AllowMultiSelect = True 'cho phep chon nhieu file
    If Not .Show = -1 Then
          MsgBox ("khong chon file nao"), vbCritical, "KK"
          Application.ScreenUpdating = True
          Application.DisplayAlerts = True
          Application.AskToUpdateLinks = True
          Exit Sub
    End If
    ReDim arr1(1 To Rows.Count, 1 To 2)
    For Each k In .SelectedItems
      Set wb = Workbooks.Open(k)
        b = wb.Sheets(1).Range("a" & Rows.Count).End(xlUp).Row
        If b > 4 Then
           arr = wb.Sheets(1).Range("A1:B" & b).Value
           s = wb.Name
           For i = 5 To UBound(arr, 1)
                If dic.exists(arr(i, 1)) = 0 Then
                    a = a + 1
                   dic.Item(arr(i, 1)) = Array(a)
                   arr1(a, 1) = arr(i, 1)
                   arr1(a, 2) = arr(i, 2)
                Else
                   c = dic.Item(arr(i, 1))(0)
                   arr1(c, 2) = arr1(c, 2) + arr(i, 2)
                End If
           Next i
         wb.Close False
         Set ws = Worksheets.Add(, Sheets(1))
             ws.Name = s
             ws.Range("A1").Resize(UBound(arr, 1), 2).Value = arr
             Erase arr
       Else
          wb.Close False
       End If
    Next
    End With
    tong.Range("a5").Resize(Rows.Count - 10, 2).ClearContents
    tong.Range("a5").Resize(a, 2) = arr1
    Set dic = Nothing
    Application.ScreenUpdating = True
    Application.DisplayAlerts = True
    Application.AskToUpdateLinks = True
End Sub
Em cám ơn, cho em hỏi khi chạy code thì nó chỉ tổng hợp từng file một ạ ?
 

Bùi Thúy Thúy

Thành viên thường trực
Tham gia ngày
2 Tháng bảy 2018
Bài viết
287
Được thích
35
Điểm
185
Tuổi
32
Nó tổng hợp những File nào bạn chọn.Ở sheets 1.
Vâng, ý em là tổng cộng tổng của các file lại ạ! em có 10 file, mỗi file có 1 sheet có cấu trúc tương tự nhau ạ!
Chứ không đơn thuần cộng riêng trong sheet của 1 file ạ
 

snow25

Thành viên gắn bó
Tham gia ngày
24 Tháng bảy 2018
Bài viết
2,351
Được thích
2,179
Điểm
360

befaint

|||||||||||||
Tham gia ngày
6 Tháng một 2011
Bài viết
8,903
Được thích
10,267
Điểm
1,560
Giờ tập viết thành những sub() con cho những chỗ lặp lại, dùng nhiều lần (có thể lưu thành thư viện của riêng mình..).
Ví dụ:
PHP:
sub tangtoc_app(byval bBool as boolean)
'Application. = not bBool
End sub
Trong sub chính cần gọi nó
PHP:
' Lần đầu tiên False thì viết
tangtoc_app True
'...
 

Bùi Thúy Thúy

Thành viên thường trực
Tham gia ngày
2 Tháng bảy 2018
Bài viết
287
Được thích
35
Điểm
185
Tuổi
32
Giờ tập viết thành những sub() con cho những chỗ lặp lại, dùng nhiều lần (có thể lưu thành thư viện của riêng mình..).
Ví dụ:
PHP:
sub tangtoc_app(byval bBool as boolean)
'Application. = not bBool
End sub
Trong sub chính cần gọi nó
PHP:
' Lần đầu tiên False thì viết
tangtoc_app True
'...
Vâng em cám ơn, nhưng em chưa biết gì về vba ạ! thầy làm mẫu giúp em 1 lần được không ạ!
 

snow25

Thành viên gắn bó
Tham gia ngày
24 Tháng bảy 2018
Bài viết
2,351
Được thích
2,179
Điểm
360
Vâng, khi chạy code thì có hiện như hình dưới, cho em hỏi nhấn vào file nào hay từng file một ạ View attachment 208700
Bạn chọn toàn bộ những file cần tổng hợp là được.
Bài đã được tự động gộp:

Lần trước nhắc chỗ này rồi, cho từ khóa rồi mà không chịu tìm hiểu.
Đối tượng sheet có 2 loại: worksheet và chart sheet.
Em tìm hiểu cũng không biết cách dùng.Anh có thể chỉ ra có khả năng lỗi ở đâu không ạ.
 
Lần chỉnh sửa cuối:

Bùi Thúy Thúy

Thành viên thường trực
Tham gia ngày
2 Tháng bảy 2018
Bài viết
287
Được thích
35
Điểm
185
Tuổi
32
Bạn chọn toàn bộ những file cần tổng hợp là được.
Bài đã được tự động gộp:


Em tìm hiểu cũng không biết cách dùng.Anh có thể chỉ ra có khả năng lỗi ở đâu không ạ.
Vâng em cám ơn ạ!
Bài đã được tự động gộp:

Bạn chọn toàn bộ những file cần tổng hợp là được.
Bài đã được tự động gộp:


Em tìm hiểu cũng không biết cách dùng.Anh có thể chỉ ra có khả năng lỗi ở đâu không ạ.
Anh cho em hỏi thêm chút, những file cần tổng hợp đặt tên không theo quy luật vẫn được chứ ạ!
 
Lần chỉnh sửa cuối:

snow25

Thành viên gắn bó
Tham gia ngày
24 Tháng bảy 2018
Bài viết
2,351
Được thích
2,179
Điểm
360
Vâng em cám ơn ạ!
Bài đã được tự động gộp:


Anh cho em hỏi thêm chút, những file cần tổng hợp đặt tên không theo quy luật vẫn được chứ ạ!
Uh nó vẫn tổng hợp hết mà.Miễn sao là cấu trúc dữ liệu không thay đổi.
 
Top Bottom