Tổng hợp số liệu từ nhiều file Excel vào một file EXcel

[tabatbai]

Cho em học hỏi chút ạ, chẳng là em có số liệu từ nhiều file Excel em muốn tổng hợp vào một file theo hình thức cộng tổng ( Không phải gộp dữ liệu từ nhiều file vào một file), các cao thủ chỉ giúp em với ạ, em cảm ơn rất nhiều. Em có nén một số file mẫu mọi người giúp em nhé!

 

[HieuCD]

Cho em học hỏi chút ạ, chẳng là em có số liệu từ nhiều file Excel em muốn tổng hợp vào một file theo hình thức cộng tổng ( Không phải gộp dữ liệu từ nhiều file vào một file), các cao thủ chỉ giúp em với ạ, em cảm ơn rất nhiều. Em có nén một số file mẫu mọi người giúp em nhé!

Chạy code, chọn các file cần tổng hợp

Sub GopDL()
  Dim rs As Object, mainFile As Variant
  Dim sFile, sArr, Res()
  Dim n&, ik&, j&
 
  On Error Resume Next
  ReDim Res(1 To 6, 1 To 11)
  sFile = GetFile(ThisWorkbook.Path)
  If TypeName(sFile) = "Variant()" Then
    mainFile = ThisWorkbook.Name
    For n = 1 To UBound(sFile)
      If mainFile <> Right(sFile(n), Len(mainFile)) Then
        sArr = Empty
        With CreateObject("ADODB.Connection")
          .Open "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & sFile(n) & ";Extended Properties=Excel 12.0"
          sArr = .Execute("select * from [Si so$] where f2 is not null").GetRows
          If IsNumeric(Mid(sArr(1, 1), 1, 1)) Then
            ik = Mid(sArr(1, 1), 1, 1)
            If ik >= 1 And ik <= 5 Then
              For j = 2 To UBound(sArr, 1)
                Res(ik, j - 1) = Res(ik, j - 1) + Val(sArr(j, 1))
                Res(6, j - 1) = Res(6, j - 1) + Val(sArr(j, 1))
              Next j
            End If
          End If
          .Close
        End With
      End If
    Next n
    Set rs = Nothing
  End If
  Sheets("Sheet1").Range("C5").Resize(6, 11) = Res
End Sub

Private Function GetFile(ByVal strPath As String)
  Dim Fldr As FileDialog, Res
  Set Fldr = Application.FileDialog(msoFileDialogFilePicker)
  With Fldr
    .AllowMultiSelect = True
    .InitialFileName = strPath
    .Filters.Add "Images", "*.xls*"
    If .Show <> -1 Then GoTo NextCode
    If .SelectedItems.Count = 1 Then
      Res = Array("", .SelectedItems(1))
    Else
      ReDim Res(1 To .SelectedItems.Count)
      For i = 1 To .SelectedItems.Count
        Res(i) = .SelectedItems(i)
      Next i
    End If
  End With
  GetFile = Res
NextCode:
  Set Fldr = Nothing
End Function

 

[VetMini]

Code của bạn ở cuối nó có close cái connection rồi. Vì vậy chỉ cần lập object ADOBD.Connection một lần. Cứ mỗi file thì mở connection với nó.
Tôi không rõ điều kiện tổng hợp ra sao cho nên không thể đề nghị tổng hợp qua câu SQL thế nào.

 

[HieuCD]

Code của bạn ở cuối nó có close cái connection rồi. Vì vậy chỉ cần lập object ADOBD.Connection một lần. Cứ mỗi file thì mở connection với nó.
Tôi không rõ điều kiện tổng hợp ra sao cho nên không thể đề nghị tổng hợp qua câu SQL thế nào.

Mỗi lần mở file chỉ lấy 1 dòng với địa chỉ B8:M8, thử nhiều cách nhưng không lấy được 1 dòng nên phải lấy hết và loại dòng trống
Chỉnh lại code lập object ADOBD.Connection một lần

Sub GopDL()
  Dim sFile, sArr, Res(), mainFile$
  Dim n&, ik&, j&
 
  On Error Resume Next
  ReDim Res(1 To 6, 1 To 11)
  sFile = GetFile(ThisWorkbook.Path)
  If TypeName(sFile) = "Variant()" Then
    mainFile = ThisWorkbook.Name
    With CreateObject("ADODB.Connection")
      For n = 1 To UBound(sFile)
        If mainFile <> Right(sFile(n), Len(mainFile)) Then
          sArr = Empty
          .Open "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & sFile(n) & ";Extended Properties=Excel 12.0"
          sArr = .Execute("select * from [Si so$] where f2 is not null").GetRows
          If IsNumeric(Mid(sArr(1, 1), 1, 1)) Then
            ik = Mid(sArr(1, 1), 1, 1)
            If ik >= 1 And ik <= 5 Then
              For j = 2 To UBound(sArr, 1)
                Res(ik, j - 1) = Res(ik, j - 1) + Val(sArr(j, 1))
                Res(6, j - 1) = Res(6, j - 1) + Val(sArr(j, 1))
              Next j
            End If
          End If
          .Close
        End If
      Next n
    End With
  End If
  Sheets("Sheet1").Range("C5").Resize(6, 11) = Res
End Sub

Private Function GetFile(ByVal strPath As String)
  Dim Fldr As FileDialog, i&, Res
 
  Set Fldr = Application.FileDialog(msoFileDialogFilePicker)
  With Fldr
    .AllowMultiSelect = True
    .InitialFileName = strPath
    .Filters.Add "Images", "*.xls*"
    If .Show <> -1 Then GoTo NextCode
    If .SelectedItems.Count = 1 Then
      Res = Array("", .SelectedItems(1))
    Else
      ReDim Res(1 To .SelectedItems.Count)
      For i = 1 To .SelectedItems.Count
        Res(i) = .SelectedItems(i)
      Next i
    End If
  End With
  GetFile = Res
NextCode:
  Set Fldr = Nothing
End Function

 

[Kiều Mạnh]

Code của bạn ở cuối nó có close cái connection rồi. Vì vậy chỉ cần lập object ADOBD.Connection một lần. Cứ mỗi file thì mở connection với nó.
Tôi không rõ điều kiện tổng hợp ra sao cho nên không thể đề nghị tổng hợp qua câu SQL thế nào.

Soi tinh thật

 

[VetMini]

Mỗi lần mở file chỉ lấy 1 dòng với địa chỉ B8:M8, thử nhiều cách nhưng không lấy được 1 dòng nên phải lấy hết và loại dòng trống
...

Bạn đã thử?
"select * from [Si so$$b8:$m8] ... "

Tôi hiện không dùng Windows cho nên không tự thử được.
Vả lịa, tôi ngại mở file rar lắm.

 

[HieuCD]

Bạn đã thử?
"select * from [Si so$$b8:$m8] ... "

Tôi hiện không dùng Windows cho nên không tự thử được.
Vả lịa, tôi ngại mở file rar lắm.

Thử rồi vẫn không được, gởi bạn 1 file dữ liệu, nhờ bạn tìm cách lấy dữ liệu trực tiếp từ b8:m8

 

[VetMini]

Thử rồi vẫn không được, gởi bạn 1 file dữ liệu, nhờ bạn tìm cách lấy dữ liệu trực tiếp từ b8:m8

Máy windows của tôi đang kẹt. Chắc phải đợi giải đáp từ bạn khác.

 

[tabatbai]

Em cảm ơn mọi người rất nhiều, mọi người có gì cứ chia sẻ để em học hỏi thêm nhé!
Giải thích câu lệnh giúp em được ko? em xem nhiều rồi mà hiểu được ít quá.